Excel成绩分析表的特殊排序

347333

转眼又快到期末了，成绩的统计和分析工作是必不可少的。笔者是个遇事喜欢思考的人，经常喜欢钻研一些事半功倍的小技巧，今天给大家介绍如何利用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”就可以了。