本軟件下載地址
小學初高中考試成績統計分析管理系統
http://wenku.baidu.com/view/4c148eea647d27284a735167.html
高中考試成績統計分析管理系統（有文理班）
http://wenku.baidu.com/view/c6c8c3062cc58bd63086bd60.html
【摘要】為了保證學生成績錄入和處理的公平性，為了防止考試改卷中的不正當競爭，學校一般都會將同一年級的學生打亂，混合編班進行測試和錄入分數。為了提高數據分析的效率，避免不必要的重復工作，本文利用Excel VBA編程方法輕松實現了不破壞原始表，且不受班數和人數限制的前提下，及時准確地對成績進行處理和分析。
【關鍵詞】教學成績 統計 分析 Excel VBA
在學校的教學活動中，通過統計分析學生的考試成績，以便確定學生的接受效果和教學的方法是否得當，為教學方法的改進提供依據，是每一位任課教師所要做的重要教學工作之一。有了Excel，我們可用不用躬着身、駝着背、拿着計算器一個一個算着學生的成績了，大大提高工作效率、規范處理過程、減少差錯。
為了保證學生成績錄入和處理的公平性，為了防止考試改卷中的不正當競爭，很多學校采用全年級混合編班考試，而統計成績時，則是將已判分但未拆封的考卷統一交到教務處，按座位號順序(每本考卷的自然順序)統一錄入成績。也就是說，把同年級多個班的學生成績統一錄入到一個Excel工作表中，再分析統計出全年級各科成績。這種情況下，想在不破壞原始工作表的情況下統計分析各科各班成績，采用排序、篩選等人工干預完成統計是一件很枯燥、很繁瑣、工作量很大的事。那么，能不能用相對比較簡單的辦法來解決問題呢?答案顯然是肯定的。
Excel是微軟公司的Microsoft office的組件之一，它可以進行各種數據的處理、統計分析，在學校工作中有着廣泛的應用。例如花名冊、座位表、登分表等的電子文檔都是使用它來創建的。Excel不僅具有強大的制表功能，同時還內置了系統開發工具VBA。VBA是指Visual Basic for Application，它是在Office中廣泛應用的宏語言，可以直接對Excel對象進行編程，從而提高Excel的利用效率。使用它可以增強Excel的自動化能力，使用戶更高效地完成特定任務。因此，筆者空閑時用VBA編了個程序，輕松快速地統計分析成績（如個人總分，按班或年級排名、總分、平均分、最高分、最低分、名次或分數段人數、年級或班級前XX名等，並可輸出打印），不破壞原始工作表，不受班數和人數限制，可自定義作弊、缺考、0分是否參與統計分析，經實際應用，操作簡單，方便實用。
程序分為排名、統計、查詢、打印四大模塊，設計完成后，工作人員只需導入原始成績表：第一行為列標題且有班級一列和不合並單元格即可，其它不受任何限制（如存在空行或空列；可以任意增加刪除科目；可以任意增加刪除輔助列如：學號、年級、座位號等；而且各列位置任意；不受班數、人數、科目數限制，行列不受限制等，如圖1）。在設置工作表中設置各科滿分、優秀線、及格線、低分線、分數段、名次段、任課教師后，即可進行成績統計、查詢及打印輸出。
圖1
一、個人總分計算
因原始成績表不限制科目數且各列位置任意，而且還想任意搭配科目計算總分，如：文綜（政史地）、理綜（理化生），為了方便缺考、作弊的統計，原始成績表錄入-2代表缺考，計0分、-1代表作弊，計0分，不能用自動求和公式SUM計算總分。本軟件按照設置的總分科目采用循環方式計算總分。
圖2 總分科目
代碼：利用VBA數組加快代碼運行速度
Arr = Worksheets ("原始成績").UsedRange.Value '將原始成績表寫入數組
Arr1 = Worksheets ("總分設置").UsedRange.Value '將總分設置表寫入數組
For y = 2 To UBound(Arr1 ,2) '總分科目循環
ReDim Preserve ArrZF(1 To R, 1 To i)
ArrZF(1, i) = Arr1(1, y) '寫入總分科目
For x = 2 To UBound(Arr,1) '循環學生
For j = 2 To UBound(Arr1,1) '循環單科科目
For k = 1 To UBound(Arr,2) '列標題
If Arr(1, k) = Arr1(j, y) And Val(Arr(x, k)) > 0 Then '該科成績大於0分
ArrZF(x, i) = Val(ArrZF(x, i)) + Val(Arr(x, k)) '計算總分
End If
Next
Next
Next
Next
運行結果如圖3：
圖3
二、排名
原始成績表有可能錄入-1、-2但又要按0分排名，除以年級為單位排名外還要能以班為單位排名，因此本軟件不使用工作表排名公式Rank進行排名，而是將排序科目先降序排序再按順序寫入名次，排名操作窗口如圖4。
圖4
年級排名代碼：
For i = 0 To ListBox1.ListCount - 1 '循環排名科目
.UsedRange.Sort Key1:= ListBox1.List(i), Order1:=xlDescending, Header:=xlYes, Orientation:=xlSortColumns '對科目降序排序
.Columns(kmL + 1).Insert shift:=xlShiftToRight '科目列下一列插入排名列
Arr = .Range(.Cells(1, kmL), .Cells(Sht9R, kmL + 1)).Value '科目i及名次列寫入數組
Arr(1, 2) = Arr(1, 1) & "級名次"
Rank = 1 '初始化名次
Arr(2, 2) = Rank '第1名
For x = 3 To UBound(Arr1,1) '循環Arr所有行，對非0分排名
If Val(Arr(x, 1)) < Val(Arr(x - 1, 1)) Then '滿足小於關系
Rank = x – 1 '名次等於行號-1
End If
If Val(Arr(x, 1)) > 0 Then
Arr(x, 2) = Rank '寫入名次
RankLast = Rank '記錄最后一個名次
End If
Next x
For x = UBound(Arr1,1) To 2 Step -1
If Len(Arr(x, 1)) > 0 Then
Select Case Val(Arr(x, 1))
Case 0 '零分參與排名
If CheckBox4.Value Then
Arr(x, 2) = RankLast + 1
End If
Case -1 '作弊參與排名
If CheckBox6.Value Then
Arr(x, 2) = RankLast + 1
End If
Case -2 '缺考參與排名
If CheckBox5.Value Then
Arr(x, 2) = RankLast + 1
End If
Case Is > 0
Exit For
End Select
End If
Next x
Next i
班級排名先以班級及排名科目為關鍵字進行多條件排序，找出某班開始行號及結束行號，然后按上述方式循環班級所在行進行排名。代碼如下：省略重復部分
For i = 0 To ListBox2.ListCount - 1 '循環排名科目
……
For x = 3 To UBound(Arr1,1)
'記錄班級開始行號start,結束行號over****
start = x
over = 0
For x1 = start + 1 To Sht9R
If Arr1(x1, 1) <> Arr1(x1 - 1, 1) Then
over = x1 - 1
Exit For
End If
Next x1
If x1 > UBound(Arr1,1) Then
over = UBound(Arr1,1)
End If
'*********
For x1 = start + 1 To over '按班排名
……
Next x1
If over >= start Then
x = over
End If
Next x
Next i
運行結果如圖5。
圖5
三、統計各項指標
本軟件以班級列統計應考人數，科目列統計該科實考人數，單元格為空不參與統計。以班級為關鍵字排序后通過For循環某科目列的各行，計算各班總分、平均分，統計優秀人數、及格人數、低分人數、各分數段及名次段人數、最高分、最低分。統計窗口如圖6。
圖6
代碼：
ArrSht6 = .UsedRange .Value '分數設置讀入VBA數組
ArrSht7 = .UsedRange .Value '教師名單讀入VBA數組
.UsedRange.Sort Key1:= "班級", Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns '對原始成績表班級升序排序
ArrSht5 = .UsedRange .Value '原始成績表讀入VBA數組
For i = 0 To ListBox1.ListCount - 1 '循環統計科目
……
For x = 3 To UBound(ArrSht5,1)
……
'統計***********
For x1 = start + 1 To over '按班統計
If Len(ArrSht5(x1, Sht5kmL)) > 0 Then 'Sht5kmL為統計科目列號
Select Case Val(ArrSht5(x1, Sht5kmL))
Case Val(ArrSht6(3, Sht6kmL)) To Val(ArrSht6(2, Sht6kmL)) '優秀人數
CountYX = CountYX + 1
Sumbj = Sumbj + Val(ArrSht5(x1, Sht5kmL)) '班級總分
Case Val(ArrSht6(4, Sht6kmL)) To Val(ArrSht6(3, Sht6kmL)) '及格-優秀
CountJG = CountJG + 1
Sumbj = Sumbj + Val(ArrSht5(x1, Sht5kmL))
Case Val(ArrSht6(5, Sht6kmL)) To Val(ArrSht6(4, Sht6kmL)) '低分-及格
CountDJ = CountDJ + 1
Sumbj = Sumbj + Val(ArrSht5(x1, Sht5kmL))
Case 0 '零分
Count0 = Count0 + 1
Case 0 To Val(ArrSht6(5, Sht6kmL)) '低分
CountDF = CountDF + 1
Sumbj = Sumbj + Val(ArrSht5(x1, Sht5kmL))
Case -1 '作弊
Count1 = Count1 + 1
Case -2 '缺考
Count2 = Count2 + 1
End Select
If Val(ArrSht5(x1, Sht5kmL)) > kmMax Then
kmMax = Val(ArrSht5(x1, Sht5kmL)) '最高分
End If
If Val(ArrSht5(x1, Sht5kmL)) > 0 And Val(ArrSht5(x1, Sht5kmL)) < kmMin Then
kmMin = Val(ArrSht5(x1, Sht5kmL)) '最低分
End If
End If
Next x1
'*****************
'計算，記錄****************
CountA = over - start + 1 '應考人數
CountB = CountYX + CountJG + CountDF + CountDJ '實考人數
CountJG = CountJG + CountYX '及格人數
If CountB > 0 Then
eve = Sumbj / CountB '平均分（0分，作弊，缺考不參與統計）
If CheckBox9.Value Then '0分參與統計
If Count0 > 0 Then
eve = Sumbj / (CountB + Count0) '平均分（0分參與統計）
CountB = CountB + Count0 '實考人數(含0分）
CountDF = CountDF + Count0 '低分人數(含0分）
kmMin = 0 '最低分
End If
End If
If CheckBox10.Value Then '作弊參與統計
If Count1 > 0 Then
eve = Sumbj / (CountB + Count1) '平均分
CountB = CountB + Count1 '實考人數
CountDF = CountDF + Count1 '低分人數
kmMin = 0 '最低分
End If
End If
If CheckBox8.Value Then '缺考參與統計
If Count2 > 0 Then
eve = Sumbj / (CountB + Count2) '平均分
CountB = CountB + Count2 '實考人數
CountDF = CountDF + Count2 '低分人數
kmMin = 0 '最低分
End If
End If
CountYXL = CountYX / CountB '優秀率
CountJGL = CountJG / CountB '及格率
CountDFL = CountDF / CountB '低分率
'統計結果寫入數組，，，，，，，，，
tjL = tjL + 1
ReDim Preserve ArrTJ(1 To ArrbtCount, 1 To tjL)
ArrTJ(1, tjL) = ArrSht5(over, Sht5bjL) '班級
ArrTJ(2, tjL) = CountA '應考人數
ArrTJ(3, tjL) = CountB '實考人數
ArrTJ(4, tjL) = Sumbj '總分
ArrTJ(5, tjL) = eve '平均分
ArrTJ(6, tjL) = CountYX '優秀人數
ArrTJ(7, tjL) = CountYXL '優秀率
ArrTJ(8, tjL) = CountJG '及格人數
ArrTJ(9, tjL) = CountJGL '及格率
ArrTJ(10, tjL) = CountDF '低分人數
ArrTJ(11, tjL) = CountDFL '低分率
ArrTJ(12, tjL) = kmMax '最高分
ArrTJ(13, tjL) = kmMin '最低分
ArrTJ(14, tjL) = ArrSht7(Sht7bjR, Sht7kmL) '教師姓名
'，，，，，，，，，
End If
'********************
……
Next x
Next i
……
'年級數據統計************
tjL = tjL + 1
ReDim Preserve ArrTJ(1 To ArrbtCount, 1 To tjL)
ArrTJ(1, tjL) = "合計"
ArrTJ(13, tjL) = 200000
For x = 1 To UBound(ArrTJ, 2) - 1
ArrTJ(2, tjL) = Val(ArrTJ(2, tjL)) + Val(ArrTJ(2, x)) '應考人數
ArrTJ(3, tjL) = Val(ArrTJ(3, tjL)) + Val(ArrTJ(3, x)) '實考人數
ArrTJ(4, tjL) = Val(ArrTJ(4, tjL)) + Val(ArrTJ(4, x)) '總分
ArrTJ(6, tjL) = Val(ArrTJ(6, tjL)) + Val(ArrTJ(6, x)) '優秀人數
ArrTJ(8, tjL) = Val(ArrTJ(8, tjL)) + Val(ArrTJ(8, x)) '及格人數
ArrTJ(10, tjL) = Val(ArrTJ(10, tjL)) + Val(ArrTJ(10, x)) '低分人數
If Val(ArrTJ(12, x)) > Val(ArrTJ(12, tjL)) Then ArrTJ(12, tjL) = Val(ArrTJ(12, x)) '最高分
If Val(ArrTJ(13, x)) < Val(ArrTJ(13, tjL)) Then ArrTJ(13, tjL) = Val(ArrTJ(13, x)) '最低分
Next x
ArrTJ(5, tjL) = Val(ArrTJ(4, tjL)) / Val(ArrTJ(3, tjL)) '平均分
ArrTJ(7, tjL) = Val(ArrTJ(6, tjL)) / Val(ArrTJ(3, tjL)) '優秀率
ArrTJ(9, tjL) = Val(ArrTJ(8, tjL)) / Val(ArrTJ(3, tjL)) '及格率
ArrTJ(11, tjL) = Val(ArrTJ(10, tjL)) / Val(ArrTJ(3, tjL)) '低分率
'***************
名次段及分數段人數統計因頻率不確定，不能用Select Case語句而改用循環統計。代碼：
'分數段頻數讀入數組************
For x1 = 7 To 36
If Len(ArrSht6(x1, j)) > 0 Then
k = k + 1
ReDim Preserve ArrFSD(1 To 4, 1 To k)
ArrFSD(1, k) = ArrSht6(x1, j)
For m = 1 To Len(ArrFSD(1, k))
If IsNumeric(Mid(ArrFSD(1, k), m, 1)) = False Then
ArrFSD(2, k) = Val(Left(ArrFSD(1, k), m - 1)) '分隔符左側
ArrFSD(3, k) = Val(Right(ArrFSD(1, k), Len(ArrFSD(1, k)) - m)) '分隔符右側
Exit For
End If
Next m
End If
Next x1
'***************
……
'統計分數段或名次段***********
For x1 = start + 1 To over
For j = 1 To UBound(ArrFSD, 2)
If Val(ArrSht5(x1, Sht5kmL)) >= Val(ArrFSD(2, j)) And Val(ArrSht5(x1, Sht5kmL)) < Val(ArrFSD(3, j)) Then
ArrFSD(4, j) = Val(ArrFSD(4, j)) + 1
End If
Next j
Next x1
'***************
運行結果：
圖7
圖8
圖9
圖10
圖11
四、查詢
本軟件通過查詢窗口巧妙設置排序關鍵字及高級篩選條件，以AdvancedFilter高級篩選方法實現多條件查詢。可按姓名查詢、按班級查詢（分班）；按某學科（含總分）某分數段查詢；按班內名次（年級名次）段查詢（如某班前XX名、年級前XX-XX名）等，各種查詢條件還可自由組合。對查詢結果，可按某關鍵字排序后顯示，如按班級排名升序可組合出某班全部或班前XX名、年級前XX名排名等，按年級排名升序可組合出年級前XX名排名或全部排名等。窗口如圖12。
圖12
代碼：
.UsedRange.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("M1:Q2"), copytorange:=.Range("A2"), unique:=False '高級篩選
If OptionButton3 Then '排序
.UsedRange.Sort Key1:=ComboBox1.Text, Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
ElseIf OptionButton2 Then
.UsedRange.Sort Key1:=ComboBox1.Text, Order1:=xlDescending, Header:=xlYes, Orientation:=xlSortColumns
End If
運行結果：
圖13
五、打印
各項統計表冊生成完畢后，由於是每個科目或班級一張表，需要將這些表作為一個組才能一次性打印，而且可以選擇打印部分科目或班級，否則操作比較麻煩，有違簡潔高效的目的，因此，在打印和預覽上，在界面用兩個ListBox列表框提供選擇需打印的工作簿及相應的工作表，程序智能根據不同的表格設置頁面，當然也可以在界面更改頁面設置，以適應打印輸出。然后根據界面上的數據設置工作表頁面，再對這些表利用數組一次性選擇輸出打印和預覽。打印窗口如圖14所示。
圖14
代碼：
For i = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Selected(i) = True Then
ReDim Preserve ArrSht(k)
ArrSht(k) = .Name '需打印工作表讀入數組
k = k + 1
End If
Next
Worksheets(ArrSht).PrintOut '利用數組一次性輸出打印
到此，VBA編寫的考試成績統計分析程序初步完成，加上稍許美化和容錯處理，如圖15所示，一個高效簡潔的成績統計程序就完成了。
圖15
參考文獻：
羅剛君，EXCEL 2010 VBA編程與實踐 北京：電子工業出版社，2010.12
