Sub 排名AmoKat()
tm = Timer
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([h6], [h1].Cells(Rows.Count, 1).End(xlUp))
For i = 1 To UBound(Arr): xD(Arr(i, 1)) = 0: Next i '字典產生唯一值
With [i6].Resize(xD.Count) '利用 Range.Sort 排序
.Value = Application.Transpose(xD.keys)
.Sort Key1:=.Item(1), Order1:=xlDescending, Header:=xlNo
End With
For i = 1 To xD.Count: xD(Cells(5 + i, "I").Value) = i: Next i '排序序號寫入字典
For i = 1 To UBound(Arr) '查詢字典排列序號
If Arr(i, 1) = "" Then Arr(i, 1) = 0 Else Arr(i, 1) = xD(Arr(i, 1))
Next i
[i6].Resize(UBound(Arr)) = Arr '貼上資料
Set xD = Nothing: Erase Arr
Debug.Print Timer - tm '0.30"
End Sub
發表於 2021-10-19 16:42
| 