- Sub Macro1()
- Dim arr, w(9), i&, j&, k%, z$, sz%, x&
- arr = Range("a1:a" & Range("a65536").End(xlUp).Row)
- x = UBound(arr)
- For i = 3 To 100
- For j = x To x - i + 1 Step -1
- z = arr(j, 1)
- For k = 1 To Len(z)
- sz = Val(Mid(z, k, 1))
- w(sz) = w(sz) + 1
- Next
- Next
- Cells(1, i - 1).Resize(10, 1) = Application.Transpose(w)
- Erase w
- Next
- End Sub
复制代码 |