|
发表于 2015-4-17 19:43
|
显示全部楼层
本楼为最佳答案
换个思路要快一点- Sub ttt()
- arr = Sheet1.[a1].CurrentRegion
- c = UBound(arr, 2)
- Set d = CreateObject("scripting.dictionary")
- ReDim brr(0 To 100000, 0 To c)
- ReDim n(0 To c)
- brr(0, 0) = "0个"
- For j = 1 To c
- brr(0, j) = j & "个"
- For i = 1 To UBound(arr)
- If arr(i, j) <> "" Then
- x = arr(i, j) & "," & j '数值+列数
- If Not d.exists(x) Then
- d(x) = ""
- d(arr(i, j)) = d(arr(i, j)) + 1
- End If
- End If
- Next
- Next
- For i = 0 To 99999
- s = d(i)
- n(s) = n(s) + 1
- brr(n(s), s) = i
- Next
- With Sheet4
- .Cells.Clear
- .[a1].Resize(Application.Max(n), c + 1) = brr
- .Activate
- End With
- End Sub
复制代码 |
|