巧用Excel VBA编程进行成绩分析统计

本软件下载地址

小学初高中考试成绩统计分析管理系统

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