EXCEL VBA轻松处理超难排名问题

我们大家可能经常用EXCEL来制作排名表吧，用rank函数还是比较简单的。但是如果你看下面的情况，会显示相当麻烦
摘自：办公小助手（头条号）
数据源：

要求：依据F列的成绩，分别进行全市，全省，全国排名！那我们该如何解决呢？
建个宏，代码如下：Sub 排名()Dim r&, i&Dim arrtt = TimerDim d1 As Object, d2 As Object, d3 As ObjectSet d1 = CreateObject("scripting.dictionary")Set d2 = CreateObject("scripting.dictionary")Set d3 = CreateObject("scripting.dictionary")With Worksheets("Sheet1")r = .Cells(.Rows.Count, 1).End(xlUp).Row.Range("g4:i" & r).ClearContentsarr = .Range("a4:i" & r)For i = 1 To UBound(arr)If Len(arr(i, 6))  0 Thend1(arr(i, 6)) = d1(arr(i, 6)) + 1If Not d2.exists(arr(i, 5)) ThenSet d2(arr(i, 5)) = CreateObject("scripting.dictionary")End Ifd2(arr(i, 5))(arr(i, 6)) = d2(arr(i, 5))(arr(i, 6)) + 1If Not d3.exists(arr(i, 5)) ThenSet d3(arr(i, 5)) = CreateObject("scripting.dictionary")End IfIf Not d3(arr(i, 5)).exists(arr(i, 4)) ThenSet d3(arr(i, 5))(arr(i, 4)) = CreateObject("scripting.dictionary")End Ifd3(arr(i, 5))(arr(i, 4))(arr(i, 6)) = d3(arr(i, 5))(arr(i, 4))(arr(i, 6)) + 1End IfNextKK = d1.keysnn = 1For k = 0 To UBound(KK)mm = Application.Large(KK, k + 1)ss = d1(mm)d1(mm) = nnnn = nn + ssNextFor Each aa In d2.keysKK = d2(aa).keysnn = 1For k = 0 To UBound(KK)mm = Application.Large(KK, k + 1)ss = d2(aa)(mm)d2(aa)(mm) = nnnn = nn + ssNextNextFor Each aa In d3.keysFor Each bb In d3(aa).keysKK = d3(aa)(bb).keysnn = 1For k = 0 To UBound(KK)mm = Application.Large(KK, k + 1)ss = d3(aa)(bb)(mm)d3(aa)(bb)(mm) = nnnn = nn + ssNextNextNextFor i = 1 To UBound(arr)If Len(arr(i, 6))  0 Thenarr(i, 9) = d1(arr(i, 6))arr(i, 8) = d2(arr(i, 5))(arr(i, 6))arr(i, 7) = d3(arr(i, 5))(arr(i, 4))(arr(i, 6))End IfNext.Range("a4").Resize(UBound(arr), UBound(arr, 2)) = arrEnd WithEnd Sub然后运行宏即可！！！效果如下图所示，厉害吧。

这里要说下，本工作表表名要是Sheet1，如果不是，你可以要让第七排的代码“With Worksheets("Sheet1")”修改为自己的表名；还有要保证成绩在F这一栏哦。该代码适用范围比较广，比如也可用于班级年级排名等，只要保证E列为大类，F列为小类均可使用。朋友们，怎么样简单吧，感觉复制代码，去试试看噻。