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