计算机函数成绩排名,EXCEL工具程序：成绩排名

EXCEL工具程序：成绩排名

一、功能简介：

本小程序采用VB编写，可以对EXCEL数据表进行排名，主要有以下几种功能：

1、单列排名：按某一列进行排名，如成绩总分，或某一单科成绩；

2、多列排名：可以指定较复杂的排名规则，如先按总分、如并列再按语文、再按数学...；

3、多列快排：表面上与多列排名差不多，但使用了不同的算法，速度会很快。但要求参与排名的列必须是：整数、不超过3位数、指定的排名规则不超过5列；

4、分类排名：按不同学校、或不同班级排名时可使用此功能，可同时指定多个类别同时排名；

5、查找重复：按多列排名后往往能消除并列名次，但数据量很大时还会有完全同名次的情况。本功能可查找哪些名次有多少完全同名。也可对任意一列进行查找重复值并导出。

6、显示EXCEL：操作时，可显示EXCEL界面，这样就能直观地看到数据生成的情况。注意完成排名后，先隐藏EXCEL，再关闭程序，否则程序将失去操作对象。

在使用时，程序下面会显示当前操作情况和提示，一些操作也会弹出窗口提示。

程序下载：www.hnkszx.com 资料下载——工具程序——VBE03.RAR

(新浪博客好像不支持文件下载，网站也不支持直接链接下载，只能提供下载网址了)

二、程序界面：

说明：《测试数据》给出了排名次结果，第一行设为黄色的几列是程序生成的，其中：

[总分名次]是通过“单列排名”得到，可见723分第6名，出现3个并列；

[名次]：通过按“总分、语文、数学、外语、综合”顺序“多列快排”或“多列排名”得到，此时并列名次将会减少，见图中蓝色区域；

[外语名次]：单列排名生成的名次列，会命名为“XX名次”列；而多列排名生成的列号为“名次”列；

[按班级排名]、[按类别班级排名]：这2列是用“分类排名”得到，注意分类排名前应先按预定规则进行单列或多列排名、生成“名次”列，然后再按此名次来进行分类排名的。

测试数据为500行，在生成以上不同排名列中，基本上都能很快完成。但如果数据行增加到10000条，则可产生明显差异：单列排名、多列快排，也可较快完成排名；多列排名、分类排名则耗时颇多，经测试，每完成一个指定的规则列约需30秒，如果您指定了5列来进行，大概需要二三分钟才能完成。

三、附加功能：

程序附带“查找重复”功能，主要用于检查生成的名次中，是否存在并列名次，如下图：

此功能也可用于对任意一列查找重复值。当查找的列数据较长，可能在程序的列表框C中显示不下时，可以双击某行查阅。也可右击C框将全部重复值导出到一个新的EXCEL文件中查看或保存。

右击C列表框时会显示：

四、程序核心算法：

1、单列排名：使用了公式RANK

2、多列排名：第一列仍旧使用公式RANK，后续各列使用SUMPRODUCT函数，再与第一次排名生成的名次合成，逐一完成排名，最后将公式复制成值。因SUMPRODUCT函数运算量巨大，所以本功能在数据量大时会十分耗时；

3、多列快排：对于不超过3位整数、不超过5列时，先将这几列数据合成一列15位小数，再对此小数用公式RANK排名，因而速度极快，但使用自由度没有多列排名高；

4、分类排名：也是使用公式SUMPRODUCT，在名次列基本上进行运算，也很费时。

五、部分代码示例：(注意是VB代码，不是VBA)

1、单列排名时使用RANK函数：

'----------------Max_C：最大列号；Max_R：最大行号------------

XLsheet.Cells(1, Max_C + 1).Select

ActiveCell.FormulaR1C1 = List2.Text &

"名次"

Label1.Caption = "正在生成名次列，需要一定时间......"

'-------------写入第二格公式,再按最大行填充，并复制成数据-----

XLsheet.Cells(2, Max_C +

1).Select '在EXCEL单元格，公式形如：=RANK(M2,$M$2:$M$500)

ActiveCell.FormulaR1C1 = "=RANK(RC[" & Sort_C -

Max_C - 1 _

&

"],R2C" & Sort_C & ":R"

& Max_R & "C" &

Sort_C & ")"

Selection.AutoFill Destination:=Range(Cells(2, Max_C + 1),

Cells(Max_R, Max_C + 1))

Range(Cells(2, Max_C + 1), Cells(Max_R, Max_C + 1)).Select

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,

SkipBlanks _

:=False, Transpose:=False

Label1.Caption = "已按" & List2.Text

& "生成名次，正在保存......"

'----------------------保存工作薄------------------------------

Range("A1").Select

Application.DisplayAlerts = False

ActiveWorkbook.Save

Application.DisplayAlerts = True

2、多列排名时，第一列仍使用RANK函数，后续列使用SUMPRODUCT函数，下面列出程序在处理第2列及之后排名的VB代码：

'-------从指定的第2个排名列起到最后一个循环--------------

For i = 2 To List3.ListCount

Label1.Caption = "程序正在为列《" & List2.List(A(i) - 1)

& "》生成名次，操作十分耗时，CPU正在拼命运算......" _

& "如果已显示EXCEL界面，可在左下角观察运算进度。"

Label1.ForeColor = IIf(i Mod 2 = 0, vbRed, vbBlack)

Cells(2,

C2).Select

ActiveCell.FormulaR1C1 = _

"=RC[-1]+SUMPRODUCT((R2C[-1]:R" & Max_R

& "C[-1]=RC[-1])*(R2C" _

& A(i) & ":R" &

Max_R & "C" & A(i)

& ">RC" & A(i)

& "))"

'核心代码，生成单元格公式，下二句分别为VBA和EXCEL中格式，具体数据由变量替代

'"=RC[-1]+SUMPRODUCT((R2C19:R7425C19=RC19)*(R2C14:R7425C14>RC14))"

'=S2 +SUMPRODUCT(($S$2:$S$7425=$S2) *($N$2:$N$7425>$N2)) Cells(2, C2).Select

Selection.AutoFill Destination:=Range(Cells(2, C2), Cells(Max_R,

C2))

Range(Cells(2, C2), Cells(Max_R,

C2)).Select '在本列选择性粘贴速度较快

Selection.Copy

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,

SkipBlanks _

:=False, Transpose:=False

Application.CutCopyMode = False

Selection.Copy '再次在复制粘贴覆盖原数据，形成新的排名数据

Cells(2,

C1).Select

ActiveSheet.Paste

Next

3、分类排名：

与多列排名相同的是：同样使用了SUMPRODUCT公式；不同的是：多列排名每次在公式中使用二个比较值相乘生成排名，再进行下一轮的公式引用。而分类排名不管几列参与排名，是一次性合成公式，参数中将有多个比较值相乘。代码如下：

Private Sub Command5_Click()

Dim

Max_R, Max_C As Integer

Dim C_MC As

Integer '名次列在第几列

Dim A() As

Integer '存放参与分类排名列的列号

Dim C1, C2

As

Integer '生成排名的列、及临时列的列号

Dim StrC1,

StrFm, StrOk As String '合成公式用字符串

On Error GoTo Openfile

If

MsgBox("分类排名：" _

& vbCrLf &

"1.数据表中必须已有《名次》列，否则请先生成《名次》列；" _

& vbCrLf &

"2.如果数据表中有多个《名次》列，则以最后一个为准；" _

& vbCrLf &

"3.参与分类排名的各列，可以是字符型、也可以是数值型；" _

& vbCrLf &

"4.指定的多个分类顺序无关，对排名结果无影响。" _

& vbCrLf &

"5.数据量大时，将比较耗时(1万记录约需半分钟)。" _

& vbCrLf & vbCrLf &

"是否继续？", vbYesNo) = vbNo Then

Exit Sub

End If

Label1.Caption = "准备开始分类排名..."

Range("A1").Select '获取行列

Max_R =

ActiveCell.SpecialCells(xlLastCell).Row '获取数据区域行列

Max_C =

ActiveCell.SpecialCells(xlLastCell).Column

C1 = Max_C +

1

For j = 1 To

Max_C

If Cells(1, j) = "名次" Then C_MC = j

Next

If C_MC = 0

Then

MsgBox "数据中没有《名次》列，无法进行分类排名！"

Exit Sub

End If

ReDim

A(List3.ListCount + 1)

For i = 1 To

List3.ListCount

xh = Split(List3.List(i - 1), vbTab)

A(i) = xh(0)

Next

StrC1 =

"按" '合成字段名字符串

StrFm =

"" '合成公式用字符串

For i = 1 To

List3.ListCount

StrC1 = StrC1 & Cells(1, A(i)).Value

StrFm = StrFm & "(R2C" & A(i)

& ":R" & Max_R &

"C" & A(i) & "=RC"

& A(i) & ")*"

Next

Cells(1, C1)

= StrC1 & "排名"

Cells(2,

C1).Select

StrOk =

"=SUMPRODUCT(" & StrFm _