Excel vba学生各班成绩分析统计及对应模板.doc

Excel vba学生各班成绩分析统计及对应模板（修正版）访问_/file/id_84798498557394945.htm可下载相应模板及vba代码。各班成绩分析统计.xla vba代码（修正版）适合的学校计算方式为：在单科成绩按总分降序排列取前“N”(平均基数)名的基础上求单科平均及对全年级求年级平均，班名及年名在执行一下“清( )”后可自动显示出来，（注意：请修改一下暂坐生标志，防止先删了数据）模块2代码：Sub 清()清除“姓名”字段中含“N/A”的无效数据。清除“姓名”字段中含“a”的暂坐生。Dim i, j As Integeri = Range(A65536).End(xlUp).RowFor j = 1 To iIf IsError(Cells(j, 3) ThenRows(j).ClearContentsElseIf InStr(Cells(j, 3), a) 0 Then (”a”为暂坐生标志，模板中“A”为正确暂坐生标志，可自改)Rows(j).ClearContentsEnd IfNextEnd SubSub 统() ActiveCell.Formula = =sum(a1:f1)/ & i ActiveCell.FormulaR1C1 = =SUM(R-6C:R-1C)/ & i & Application.Run Book2.xls!Macro1 清除不必要数据 MsgBox 请先设好暂座标志 Application.Run 清 初始化 班级个数 平均基数 Dim i, m, j, n, o, jm, zh, li, newRange As Integer Dim i, m, j, n, o, newRange As Integer Dim tellMe As String On Error GoTo VeryEnd tellMe = 请输入一个平均基数 tellMe2 = 请输入一个正确的最大班级个数 i = Application.InputBox(prompt:=tellMe, Title:=平均基数, Default:=50, Type:=1) m = Application.InputBox(prompt:=tellMe2, Title:=班级个数, Default:=8, Type:=1) If i = False Then Exit Sub If m = False Then Exit SubVeryEnd: 求各班各科平均分 科目 Range(D2).Range(A1:I1).Select Selection.Copy Range(Q2).Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, 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 班级 j = 1 执行的班级个数 n = 83 执行的求平均 行号定位 o = 3 执行聚集 行号定位 While j = m 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 ActiveCell.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.Formula = Cells(o, zh) + Cells(o, li) ActiveCell.FormulaR1C1 = =Application.WorksheetFunction.Sum(Chr( Asc(a) + zh- 1) & o , Chr(Asc(a) + li- 1) & o ) Chr (Asc(a) + li - 1) & 2 & : ActiveCell.FormulaR1C1 = Application.WorksheetFunction.Sum(Cells(o, zh), Cells(o, li) ActiveCell.FormulaR1C1 = =SUM(RC-3,RC-4) 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”位小数（红色） Range(Q3:Z12).Select Selection.NumberFormatLocal = 红色0.00_ ;红色-0.00 清空多余列 Dim jm As IntegerFor 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 IfNext 清空无效数据 For Each c In Range(Range(A1), ActiveCell.SpecialCells(xlLastCell) If IsError(c) Then c.ClearContents End If Next c End SubThisbook代码：Private Sub Workbook_Open() Workbook_AddinInstall Add New CommandBar End SubPrivate Sub Workbook_AddinInstall() Dim CB As CommandBarControl Dim i As Integer i = 1 For Each CB In Application.CommandBars(1).Controls If CB.Caption = 成绩处理 Then 菜单已加入，则刪除 Application.CommandBars(Worksheet Menu Bar).Controls(成绩处理).Visible = True Application.CommandBars(Worksheet Menu Bar).Controls(成绩处理).Delete End If Next Dim objCmdBrPp As CommandBarPopup Set objCmdBrPp = Application.CommandBars.ActiveMenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=False) On Error Resume Next objCmdBrPp.Caption = 成绩处理 Set objCmdBrPp = Nothing With Application.CommandBars(Worksheet menu bar).Controls(成绩处理) .Controls.Add(Type:=msoControlButton, Before:=1).Caption = 清 .Controls(清).OnAction = 清 End With With Application.CommandBars(Worksheet menu bar).Controls(成绩处理) .Controls.Add(Type:=msoControlButton, Before:=1).Caption = 统 .Controls(统).OnAction = 统 End With 建立工具栏 Dim xBar As CommandBar Dim xButton1 As CommandBarButton Dim xButton2 As CommandBarButton On Error Resume Next Application.CommandBars(CustomBar).Delete Set xBar = Application.CommandBars.Add(Name:=成绩处理, Position:=msoBarTop, MenuBar:=False, Temporary:=False) Set xButton1 = xBar.Controls.Add(Type:=msoControlButton) Set xButton2 = xBar.Controls.Add(Type:=msoControlButton) With xButton1 .Caption = 清 .Style = msoButtonCaption .OnAction = 清 End With With xButton2 .Caption = 统 .Style = msoButtonCaption .OnAction = 统 End With With Application.CommandBars(成绩处理) .Visible = True End With Set xBar = Nothing Set xButton1 = Nothing Set xButton2 = Nothing 固定工具栏 Dim intleft As Integer, introw As Integer intleft = Application.CommandBars(formatting).Width introw = Application.CommandBars(formatting).RowIndex Application.CommandBars(成绩处理).Left = intleft Application.CommandBars(成绩处理).RowIndex = introwEnd SubPrivate Sub Workbook_BeforeClose(Cancel As Boolean) 文件关闭，就刪除菜单 Dim CB As CommandBarControl On Error Resume Next For Each CB In Application.CommandBars(1).Controls If CB.Caption = 成绩处理 Then Applic