|
发表于 2016-11-16 13:32
|
显示全部楼层
本楼为最佳答案
- Sub 按重复次数排序()
- Dim arr, d
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- For i = 1 To UBound(arr)
- n = [ai1].Column - 1
- For j = 1 To UBound(arr, 2)
- d(arr(i, j)) = d(arr(i, j)) + 1
- Next
- For j = UBound(arr, 2) To 2 Step -1
- For Each a In d.keys
- If d(a) = j Then
- n = n + 1: Cells(i, n) = a
- End If
- Next
- Next
- d.RemoveAll
- Next
- End Sub
复制代码 |
|