转眼又快到期末了，成绩的统计和分析工作是必不可少的。笔者是个遇事喜欢思考的人，经常喜欢钻研一些事半功倍的小技巧，今天给大家介绍如何利用VBA轻松实现成绩分析表的特殊排序，先看下面的实例。

　　图1是一张已经分析好的成绩分析表，可教务主任要求：要把各班各门学科所在年级的名次加在均分后，那样一看就一目了然了。以前都是用眼睛观察，然后将名次手工添加到均分后面，但成绩一经修改就不得不重新再分析了，非常麻烦。

　　大家知道，用Excel提供的升序和降序工具可以实现各学科的均分排序，但排序后，班级的顺序就乱了。如果通过排序获取均分的名次再恢复对班级的排序，这样是可行的，但八、九门学科一列一列地操作，工作量非常大，还容易出错。而且成绩修改后，还得重复劳动。后来笔者用一段VBA代码实现了这一要求。

　　用控件工具箱中的“按钮”工具画一个命令按钮，将其“Caption” 属性值改为“均分排序”，双击该按钮，在其Click事件中输入如下代码：

　　Private Sub CommandButton1_Click()
　　Dim myarray()
　　Dim m, n, i, j As Integer
　　n = Application.WorksheetFunction.CountA(Columns(1))

　　’从第二列到第八列一共循环七次

　　For m = 2 To 8

　　’给数组赋值

　　ReDim myarray(n)
　　For i = 3 To n
　　myarray(i) = Cells(i, m).Value
　　Next i

　　’用冒泡排序法对数组中的元素进行排序操作

　　For j = 0 To n - 1
　　 For i = 0 To n - 1 - j
　　 If myarray(i) 〈 myarray(i + 1) Then
　　 temp = myarray(i)
　　 myarray(i) = myarray(i + 1)
　　 myarray(i + 1) = temp
　　 End If
　　 Next
　　Next

　　’将各数值在列中的排名加括号后添加到原单元格的数值后面，中间空一个空格

　　For i = 3 To n
　　Cells(i, m).Value = Cells(i, m).Value && Space(1) && ’(’ && Application.WorksheetFunction.Match(Cells(i, m), myarray, -1) && ’)’
　　Next i
　　Next m

　　’主体程序执行完毕

　　’使各列的宽度与单元格的大小相适应

　　Cells.Select
　　Selection.Columns.AutoFit

　　’禁止该按钮功能（防止被再次点击）

　　CommandButton1.Enabled = False

　　MsgBox ’排序完成，该操作只能执行一次！’, vbOKOnly, ’提示框’

　　End Sub

　　关闭代码窗口返回到Excel工作表中，在运行模式下单击〔均分排序〕按钮，我们就会看到，各班各学科均分在年级中的名次已自动添加到相应的单元格中了（如图2）。

　　添加名次后，程序已设定了自动扩充单元格的大小以适应单元格中的内容。另外，为了防止用户多次点击〔均分排序〕按钮，该按钮在程序执行完后即被设为无效，若要再次修改本程序，只需将该按钮的“Enabled”属性值设为“True”就可以了。