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

Excelvba学生各班成绩分析统计及对应模板(修正版)访问—/file/id_84798498557394945.htm可下载相应模板及vba代码。各班成绩分析统计.xlavba代码(修正版)适合的学校计算方式为：在单科成绩按总分降序排列取前“N”(平均基数)名的基础上求单科平均及对全年级求年级平均，班名及年名在执行一下“清()”后可自动显示出来，(注意：请修改一下暂坐生标志，防止先删了数据)模块2代码：Sub清()清除“姓名”字段中含“N/A”的无效数据。清除“姓名”字段中含“a”的暂坐生。Dimi,jAsIntegeri=Range("A65536").End(xlUp).RowForj=1ToiIfIsError(Cells(j,3))ThenRows(j).ClearContentsElseIfInStr(Cells(j,3),"a")>0Then'(”a”为暂坐生标志，模板中“A”为正确暂坐生标志，可自改)Rows(j).ClearContentsEndIfNextEndSubSub统()'ActiveCell.Formula="=sum(a1:f1)/"&i'ActiveCell.FormulaR1C1="=SUM(R[-6]C:R[-1]C)/"&i&""'Application.Run"Book2.xls!Macro1"'清除不必要数据MsgBox"请先设好暂座标志"Application.Run"清"'初始化班级个数平均基数Dimi,m,j,n,o,jm,zh,li,newRangeAsInteger'Dimi,m,j,n,o,newRangeAsIntegerDimtellMeAsStringOnErrorGoToVeryEndtellMe="请输入一个平均基数"tellMe2="请输入一个正确的最大班级个数"i=Application.InputBox(prompt:=tellMe,Title:="平均基数",Default:=50,Type:=1)m=Application.InputBox(prompt:=tellMe2,Title:="班级个数",Default:=8,Type:=1)Ifi=FalseThenExitSubIfm=FalseThenExitSubVeryEnd:'求各班各科平均分'科目Range("D2").Range("A1:I1").SelectSelection.CopyRange("Q2").SelectSelection.PasteSpecialPaste:=xlPasteValuesAndNumberFormats,Operation:=_xlNone,SkipBlanks:=False,Transpose:=FalseRange("z2")="政史"'取得政史列号Forjm=17To30IfCells(2,jm)="政治"Thenzh=jmElseIfCells(2,jm)="历史"Thenli=jmEndIfNext'班级j=1'执行的班级个数n=83'执行的求平均行号定位o=3'执行聚集行号定位Whilej<=mRange("d"&n&"").FormulaArray="=AVERAGE(LARGE(R[-80]C:R[-1]C,ROW(R1:R"&i&")))"Range("d"&n&"").SelectSelection.AutoFillDestination:=ActiveCell.Range("A1:I1"),Type:=_xlFillDefaultActiveCell.Range("A1:I1").SelectSelection.CopyRange("q"&o&"").SelectSelection.PasteSpecialPaste:=xlPasteValuesAndNumberFormats,Operation:=_xlNone,SkipBlanks:=False,Transpose:=FalseRange("z"&o&"").SelectOnErrorResumeNext'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+81j=j+1o=o+1Wend'求年平均分Range("q"&o&"").SelectActiveCell.FormulaR1C1="=SUM(R[-"&m&"]C:R[-1]C)/"&m&""Selection.AutoFillDestination:=ActiveCell.Range("A1:J1"),Type:=_xlFillDefaultActiveCell.Offset(0,-1).Range("A1").SelectActiveCell.FormulaR1C1="年平"'设置格式为“2”位小数(红色)Range("Q3:Z12").SelectSelection.NumberFormatLocal="[红色]0.00_;[红色]-0.00"'清空多余列'DimjmAsIntegerForjm=17To30IfCells(2,jm)="总分"ThenColumns(jm).ClearContentsElseIfCells(2,jm)="年名"ThenColumns(jm).ClearContentsElseIfCells(2,jm)="班名"ThenColumns(jm).ClearContentsEndIfNext'清空无效数据ForEachcInRange(Range("A1"),ActiveCell.SpecialCells(xlLastCell))IfIsError(c)Thenc.ClearContentsEndIfNextcEndSubThisbook代码：PrivateSubWorkbook_Open()Workbook_AddinInstall'AddNewCommandBarEndSubPrivateSubWorkbook_AddinInstall()DimCBAsCommandBarControlDimiAsIntegeri=1ForEachCBInApplication.CommandBars(1).ControlsIfCB.Caption="成绩处理"Then '菜单已加入，则刪除Application.CommandBars("WorksheetMenuBar").Controls("成绩处理「.Visible=TrueApplication.CommandBars("WorksheetMenuBar").Controls("成绩处理").DeleteEndIfNextDimobjCmdBrPpAsCommandBarPopupSet objCmdBrPp =Application.CommandBars.ActiveMenuBar.Controls.Add(Type:=msoControlPopup,Temporary:=False)OnErrorResumeNextobjCmdBrPp.Caption="成绩处理"SetobjCmdBrPp=NothingWithApplication.CommandBars("Worksheetmenubar").Controls("成绩处理").Controls.Add(Type:=msoControlButton,Before:=1).Caption="清".Controls(“清").OnAction="清"EndWithWithApplication.CommandBars("Worksheetmenubar").Controls("成绩处理").Controls.Add(Type:=msoControlButton,Before:=1).Caption="统".Controls(”统").OnAction="统"EndWith'建立工具栏DimxBarAsCommandBarDimxButton1AsCommandBarButtonDimxButton2AsCommandBarButtonOnErrorResumeNextApplication.CommandBars("CustomBar").DeleteSetxBar=Application.CommandBars.Add(Name:="成绩处理",Position:=msoBarTop,MenuBar:=False,Temporary:=False)SetxButton1=xBar.Controls.Add(Type:=msoControlButton)SetxButton2=xBar.Controls.Add(Type:=msoControlButton)WithxButton1.Caption="清".Style=msoButtonCaption.OnAction="清"EndWithWithxButton2.Caption="统".Style=msoButtonCaption.OnAction="统"EndWithWithApplication.CommandBars("成绩处理").Visible=TrueEndWithSetxBar=NothingSetxButton1=NothingSetxButton2=Nothing'固定工具栏DimintleftAsInteger,introwAsIntegerintleft=Application.CommandBars("formatting").Widthintrow=Application.CommandBars("formatting").RowIndexApplication.CommandBars("成绩处理").Left=intleftApplication.CommandBars("成绩处理").RowIndex=introwEndSubPrivateSubWorkbook_BeforeClose(CancelAsBoolean)'文件关闭，就刪除菜单DimCBAsCommandBarControlOnErrorResumeNextForEachCBInApplication.CommandBars(1).ControlsIfCB.Caption="成绩处理"ThenAppli