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

《一键分析统计学生成绩及生成排好版的全年级排名表与各.doc》由会员分享，可在线阅读，更多相关《一键分析统计学生成绩及生成排好版的全年级排名表与各.doc（9页珍藏版）》请在得力文库 - 分享文档赚钱的网站上搜索。

1、一键分析统计学生成绩及生成排好版的全年级排名表与各班表可在分析统计各科平均分及年级平均分并生成（年名表与班名表）统计基础：各单科成绩按本身降序排列取前N名 或 各班成绩按总分降序排列取前N名(包括与第N名相同总分) *（不用手动排序，排名，在模板上点“统”一键生成）xel7000自动化工具.xla 模块代码：（模板与对应源表放在同一文件夹打开会自动取得数据，工具加载宏 加载.xla）Option ExplicitPublic Sub 每类一页（） 前提是排好类别,每班1页,按性别2页 Application.ScreenUpdating = False On Error Resume Next

2、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 S

3、trComp(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

4、Rows(c + 1).Select ActiveWindow.FreezePanes = True 原稿处理* ActiveSheet.Cells.Font.Size = 12 Call 原稿处理按类分页*选取要分类的列 rend = ActiveSheet.Cells.Find(*, , xlValues, , xlByRows, 2).RowSet srange = Range(Cells(c + 1, d), Cells(rend, d)按类分页On Error Resume NextActiveSheet.ResetAllPageBreaksn = 1sCol = srange.Ce

5、lls(1, 1).ColumnStartRow = srange.Cells(1, 1).RowEndRow = StartRow + srange.Rows.Count - 1For 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)

6、 ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(j + 1, sCol) End IfNext jss = 100缩放掉多余自动分页符*For i = 100 To 10 - 1 p = ExecuteExcel4Macro(Get.Document(50) If p = n Then Exit For If ActiveSheet.PageSetup.Zoom = 10 Then ActiveSheet.PageSetup.Zoom = 100: MsgBox 无法完成缩放,已恢复到100%缩放比例！ ss = Activ

7、eSheet.PageSetup.Zoom - 1 ActiveSheet.PageSetup.Zoom = ssNext缩放的看不清（极限）If (Rows(c + 1).Height) * ss 0 Then If ch Then Rows(j).ClearContents 有“A”的暂坐生不分析统计成绩 Else For jm = 1 To 15 If Cells(2, jm) = 年名 Then Cells(j, jm).ClearContents 有“A”的暂坐生不计算年名 Next End If End If End If NextEnd SubSub 统()分析统计各科平均分及年

8、级平均分并生成（年名表与班名表）统计基础：各单科成绩按总分降序排列取前N名 或 各班成绩按总分降序排列取前N名(包括与第N名相同总分)Dim i, m, j, n, k, o, jm, zf, zh, li As Integer, currenname, flag As String, c As Range Application.ScreenUpdating = False Dim tellMe, tellme1, tellme2 As String Application.Run 清 currenname = ActiveWorkbook.name 当前执行的应是有成绩的模板表，否则空白表

9、find处出错 Call 年名班名表(y) Workbooks(currenname).Activate Call 年名班名表(c) MsgBox 请先设好暂座标志 Application.Run 清, True 初始化 班级个数 平均基数 tellme1 = 请输入一个平均基数 tellme2 = 请输入一个正确的最大班级个数 flag = Application.InputBox(prompt:=tellMe, Title:=统计方式,各单科 0 各班 1, Default:=0, Type:=1) If flag = False Then Exit Sub i = Application

10、.InputBox(prompt:=tellMe, Title:=平均基数, Default:=50, Type:=1) If i = False Then Exit Sub m = Application.InputBox(prompt:=tellme2, Title:=班级个数, Default:=6, Type:=1) If m = False Then Exit Sub 求各班各科平均分 科目 Range(D2).Range(A1:I1).Select Selection.Copy Range(Q2).Select Selection.PasteSpecial Paste:=xlPas

11、teValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Range(z2) = 政史 取得政史列号 For jm = 17 To 30 If Cells(2, jm) = 政治 Then zh = jm ElseIf Cells(2, jm) = 历史 Then li = jm End If Next For jm = 1 To 15 If Cells(2, jm) = 总分 Then zf = jm Next 班级 j = 1 执行的班级个数 k = 3 每班开始处 n = 83

12、执行的求平均 行号定位 o = 3 执行聚集 行号定位 While j =LARGE(R-80C:R-1C,30) Cells(n, zf).FormulaR1C1 = =SUMPRODUCT(-(R-80C:R-1C=LARGE(R-80C:R-1C, & i & ) i = Cells(n, zf).Value Cells(n, 4).FormulaR1C1 = =SUMPRODUCT(-(R-80C & zf & :R-1C & zf & =LARGE(R-80C & zf & :R-1C & zf & ,30)*R-80C:R-1C)/ & i & ActiveCell.Formula

13、R1C1 = =SUMPRODUCT(-(R-80C9:R-1C9=LARGE(R-80C9:R-1C9,30)*R-80C:R-1C) i = WorksheetFunction.SumProduct(-(Range(Cells(k, zf), Cells(n, zf) = WorksheetFunction.Large(Range(Cells(k, zf), Cells(n, zf), i) Range(d & n & ).Formula = =WorksheetFunction.SumProduct(-(Range(Cells(k, zf), Cells(n, zf) = Workshe

14、etFunction.Large(Range(Cells(k, zf), Cells(n, zf), i) * Range(cells(k,4),cells(n,4) / & i & End If If flag = 0 Then Range(d & n & ).FormulaArray = =AVERAGE(LARGE(R-80C:R-1C,ROW(R1:R & i & ) Range(d & n & ).Select Selection.AutoFill Destination:=ActiveCell.Range(A1:I1), Type:= _ xlFillDefault ActiveC

15、ell.Range(A1:I1).Select Selection.Copy Range(q & o & ).Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Range(z & o & ).Select On Error Resume Next ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Sum(Cells(o, zh), Ce

16、lls(o, li) k = n + 1 n = n + 81 j = j + 1 o = o + 1 Wend 求年平均分 Range(q & o & ).Select ActiveCell.FormulaR1C1 = =SUM(R- & m & C:R-1C)/ & m & Selection.AutoFill Destination:=ActiveCell.Range(A1:J1), Type:= _ xlFillDefault ActiveCell.Offset(0, -1).Range(A1).Select ActiveCell.FormulaR1C1 = 年平 设置格式为“2”位小

17、数（红色） Range(Q3:Z12).Select Selection.NumberFormatLocal = 红色0.00_ ;红色-0.00 清空多余列 For jm = 17 To 30 If Cells(2, jm) = 总分 Then Columns(jm).ClearContents ElseIf Cells(2, jm) = 年名 Then Columns(jm).ClearContents ElseIf Cells(2, jm) = 班名 Then Columns(jm).ClearContents End If Next 清空无效数据 For Each c In Range(Range(A1), ActiveCell.SpecialCells(xlLastCell) If IsError(c) Then c.ClearContents End If Next cEnd Sub 菜单与工具栏代码：略