在Excel2000中用宏和VBa使成绩统计自动化.doc

在Excel2000中用宏和VBa使成绩统计自动化2001-11-30 12:59作者：唐秋明出处：Yesky责任编辑：在学校的教学活动中，通过统计分析学生的考试成绩，了解教学情况，为改进以后的教学工作提供依据，是整个教学工作中非常重要一环。但经常按各种不同的指标统计分析成绩，又是一件很枯燥，很繁琐的事。哪么，能否对需统计的各种指标，无需人工干预，让计算机自动完成呢？答案是肯定的，笔者通过Excel中自带的Vba，实现了这个设想。为能给被统计成绩困扰的朋友提供一些帮助，下面以我校高中三年级理科成绩统计为例，介绍其作法，供大家参考。1 设计流程,编制程序源代码：为便于说明做法，同时代码简短一点，这里以我校高三理科1-4班成绩统计为例，说明其做法。另外为使编写代码效率高一些，这里采用先录制一部分为宏，再在vba中打开编辑相结合的办法编写。 从外部的“考试成绩.XLS”工作簿中将1-4班的成绩拷贝，依次粘贴到“成绩统计表.XLS”工作簿中的“理科”表中；程序源代码：Sub 拷外部理科0()ActiveWindow.WindowState = xlMinimizedWindows(考试成绩.xls).ActivateActiveWindow.WindowState = xlMaximizedSheets(1班).SelectRange(A1:S60).SelectSelection.CopyActiveWindow.WindowState = xlMinimizedWindows(成绩统计表.xls).ActivateActiveWindow.WindowState = xlMaximizedSheets(理科).SelectActiveWindow.ScrollRow = 1Range(A1).SelectActiveSheet.Paste 拷贝“考试成绩簿”中的1班成绩表中数据，粘贴到到成绩统计表工作簿的理科表A1Range(S22).SelectActiveWindow.LargeScroll Down:=1Range(S44).SelectActiveWindow.LargeScroll Down:=1Range(S66).SelectWindows(考试成绩.xls).ActivateActiveWindow.WindowState = xlNormalSheets(2班).SelectRange(A2).SelectActiveWindow.SmallScroll Down:=43Range(A2:S58).SelectApplication.CutCopyMode = FalseSelection.CopyWindows(成绩统计表.xls).ActivateActiveWindow.WindowState = xlNormalRange(A61).SelectActiveSheet.Paste拷贝考试成绩簿中的2班成绩表中数据，粘贴到“成绩统计”工作簿的理科表A61Windows(考试成绩.xls).ActivateActiveWindow.WindowState = xlNormalSheets(3班).SelectRange(A1:S59).SelectApplication.CutCopyMode = FalseSelection.CopyWindows(成绩统计表.xls).ActivateActiveWindow.WindowState = xlNormalRange(S58).SelectActiveWindow.LargeScroll Down:=1Range(S80).SelectActiveWindow.LargeScroll Down:=1Range(S102).SelectActiveWindow.LargeScroll Down:=1Range(A118).SelectActiveSheet.Paste拷贝成绩簿中的3班成绩表中数据，粘贴到成绩统计表工作簿的理科表A118Rows(118:118).SelectApplication.CutCopyMode = FalseSelection.Delete Shift:=xlUpRange(D122).SelectWindows(考试成绩.xls).ActivateActiveWindow.WindowState = xlNormalSheets(4班).SelectRange(A2:S71).SelectSelection.CopyWindows(成绩统计表.xls).ActivateActiveWindow.WindowState = xlNormalActiveWindow.LargeScroll Down:=1Range(D144).SelectActiveWindow.LargeScroll Down:=1Range(D166).SelectActiveWindow.LargeScroll Down:=1Range(D188).SelectActiveWindow.LargeScroll Down:=-1Range(A176).SelectActiveSheet.Paste拷贝四班成绩End Sub 利用Excel的统计函数“RANK”将理科表中学生的各科成绩排名次；目的是让每位学生了解自己在全年级学生中的排名的位置。程序代码如下：Sub 理名次()Range(D2).SelectActiveCell.FormulaR1C1 = =RANK(RC-1,R2C3:R246C3,0)Selection.AutoFill Destination:=Range(D2:D246), Type:=xlFillDefaultRange(D2:D246).SelectActiveWindow.LargeScroll Down:=-13ActiveWindow.ScrollRow = 1 在工作表的D2单元格输入公式，并用拖的方式在D2-D246列复制Selection.CopyRange(F2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=$c$2:$c$246, Replacement:=$e$2:$e$246, LookAt _:=xlPart, SearchOrder:=xlByRows, MatchCase:=False拷贝D列粘贴到F列F2Selection.CopyRange(H2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=e, Replacement:=g, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False拷贝D列粘贴到H列H2Selection.CopyRange(J2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=g, Replacement:=i, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False拷贝D列粘贴到J列J2Selection.CopyRange(L2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=i, Replacement:=k, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=False拷贝D列粘贴到L列L2Selection.CopyRange(N2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=k, Replacement:=m, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=FalseColumns(N:N).ColumnWidth = 5.63Columns(N:N).ColumnWidth = 5Range(N2).SelectColumns(M:M).ColumnWidth = 5.13Range(N2).SelectActiveCell.FormulaR1C1 = =RANm(RC-1,R2C13:R246C13,0)Columns(N:N).SelectSelection.Replace What:=runm, Replacement:=runk, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=FalseRange(N2:N246).SelectSelection.Replace What:=ranm, Replacement:=rank, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=FalseSelection.CopyRange(P2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=m, Replacement:=o, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=FalseSelection.CopyRange(R2).SelectActiveSheet.PasteApplication.CutCopyMode = FalseSelection.Replace What:=o, Replacement:=q, LookAt:=xlPart, _SearchOrder:=xlByRows, MatchCase:=FalseRange(G4).Select分别选中F,H,J,.列，用查找替换的方式,将原来的C列范围”$C$2:$C$246”分别替换为对应的“”$F$2:$F$246”, ”$H$2:$H$246”,范围End Sub 将全年级理科的成绩拷贝，粘贴到新表“降序”表中，并对各科成绩按降序排序,确定分析中的A,B等优秀分数线；程序源代码如下Sub 理降幂()Sheets(理科).SelectCells.SelectSelection.CopySheets(理降幂).SelectRange(A1).SelectSelection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _False, Transpose:=FalseColumns(C:C).SelectApplication.CutCopyMode = FalseSelection.Sort Key1:=Range(C1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin将C列成绩降幂排列Columns(E:E).SelectSelection.Sort Key1:=Range(E1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin将E列成绩降幂排列Columns(G:G).SelectSelection.Sort Key1:=Range(G1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin 将G列成绩降幂排列Columns(I:I).SelectSelection.Sort Key1:=Range(I1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin 将I列成绩降幂排列Columns(K:K).SelectSelection.Sort Key1:=Range(K1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin 将K列成绩降幂排列Columns(M:M).SelectSelection.Sort Key1:=Range(M1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin将M列成绩降幂排列Columns(O:O).SelectSelection.Sort Key1:=Range(O1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin将O列成绩降幂排列Columns(Q:Q).SelectSelection.Sort Key1:=Range(Q1), Order1:=xlDescending, Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYin将Q列成绩降幂排列End Sub 建立分析表，列出各班统计的各种参数指标值。在前面的成绩统计工作簿中建立如下分语文，数学，英语，综合，总分等项目的“成绩分析”表其中的A、B优生分数线的确定，类同于高考录取线的确定。这里将各科前1-80名定为A等，第81-160名定为B等，其具体分数值，用Excel自带的函数:MIN计算，如语文的A等优秀分数线的公式为：=MIN(理降幂！C2:C200),即从理科降序表的“语文字段”第C列的第2到第200个纪录中，选取其中的最小者作为语文A等最低优秀分数线，其余各科分数线的确定，公