(一键分析统计学生成绩及生成排好版的全年级排名表与各班表.docVIP

一键分析统计学生成绩及生成排好版的全年级排名表与各班表 可在/share/link?shareid=458047uk=2902695957下载模板及.xla文件。 分析统计各科平均分及年级平均分并生成（年名表与班名表） 统计基础：各单科成绩按本身降序排列取前N名 或 各班成绩按总分降序排列取前N名(包括与第N名相同总分) *********（不用手动排序，排名，在模板上点“统”一键生成） xel7000自动化工具.xla 模块代码： （模板与对应源表放在同一文件夹打开会自动取得数据，工具—加载宏 加载.xla） Option Explicit Public Sub 每类一页（） 前提是排好类别,每班1页,按性别2页 Application.ScreenUpdating = False On Error Resume Next Dim a, srange As Range, fvalue As String, c, d, fFlag, ss, i, n, p As Integer, rend, j As Long, _ sCol As Long, StartRow As Long, EndRow As Long, sc As Single 找到分类依据******************************** fvalue = InputBox(请输入分页依据的类别, 类别, 班级) If Len(fvalue) = 0 Then Exit Sub For Each a In Intersect(Rows(1:4), ActiveSheet.UsedRange) If StrComp(a.Value, fvalue, vbTextCompare) = 0 Then a.Select fFlag = 1 c = a.Row d = a.Column MsgBox 查找成功 End If Next If fFlag 1 Then MsgBox 找不到包含【 fvalue 】的字段单元格。: Exit Sub 冻结并设置顶端标题行******************************** Rows(1: c).Font.Bold = True With ActiveSheet.PageSetup .PrintTitleRows = $1:$ c .PrintTitleColumns = End With Rows(c + 1).Select ActiveWindow.FreezePanes = True 原稿处理******************************** ActiveSheet.Cells.Font.Size = 12 Call 原稿处理 按类分页*************************************** 选取要分类的列 rend = ActiveSheet.Cells.Find(*, , xlValues, , xlByRows, 2).Row Set srange = Range(Cells(c + 1, d), Cells(rend, d)) 按类分页 On Error Resume Next ActiveSheet.ResetAllPageBreaks n = 1 sCol = srange.Cells(1, 1).Column StartRow = srange.Cells(1, 1).Row EndRow = StartRow + srange.Rows.Count - 1 For j = StartRow To EndRow - 1 If StrComp(Cells(j, sCol), Cells(j + 1, sCol), vbTextCompare) 0 Then Cells(j, sCol) Cells(j + 1, sCol) Then n = n + 1 要缩放的页数 ActiveSheet.HPageBreaks.Add Before:=Cells(j + 1, sCol) ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(j + 1, sCol) End If