|
本帖最后由 huang1314wei 于 2016-7-7 12:13 编辑
我也来凑个热闹,献丑
此代码优点:不需要对源数据排序,也可以正常得出结果!!
- Sub test()
- Dim arr, i%, d, d1, c, n%, rng As Range
- Set d = CreateObject("scripting.dictionary")
- Set d1 = CreateObject("scripting.dictionary")
- arr = Range("A1").CurrentRegion
- For i = 2 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then
- Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
- End If
- d(arr(i, 1))(CLng(arr(i, 3))) = ""
- Next
- For Each c In d.keys
- For Each c1 In d(c).keys
- n = 0
- Do
- n = n + 1
- c1 = c1 + 1
- Loop Until d(c).exists(c1) = False
- If IIf(d1(c) = "", 0, d1(c)) < n Then d1(c) = n
- Next
- Next
- For Each rng In Range("I2:I6"): rng.Offset(, 1) = d1(rng.Value): Next
- End Sub
复制代码 |
评分
-
1
查看全部评分
-
|