VBA application.rank按班排名与按级排名

VBA application.rank按班排名与按级排名
高手们写的用application.large排名的我看不懂，自己写一个用application.rank排名。抛出来见笑啦
Sub 按级排名按班排名()
Dim Rng1 As Range, Rng2 As Range, d1 As Object, d2 As Object, rngall As Range
Set d1 = CreateObject("Scripting.Dictionary")
' Set d2 = CreateObject("Scripting.Dictionary")
arr = [a1].CurrentRegion
For i = 2 To UBound(arr)
      If Not d1.exists(arr(i, 2)) Then
         Set d1(arr(i, 2)) = Cells(i, 3)
      Else
         Set d1(arr(i, 2)) = Union(d1(arr(i, 2)), Cells(i, 3))
      End If
Next i
For j = 0 To d1.Count - 1
      For Each rr In d1.items()(j)
         Cells(rr.Row, 4) = Application.Rank(rr, d1.items()(j), 0)
      Next
      If rngall Is Nothing Then
         Set rngall = d1.items()(j)
      Else
         Set rngall = Union(rngall, d1.items()(j))
      End If
Next
For Each in_all In rngall
      Cells(in_all.Row, 5) = Application.Rank(in_all, rngall, 0)
Next
End Sub

我也打它分享到论坛中去了。
http://club.excelhome.net/thread-1490406-1-1.html