|
发表于 2014-4-10 16:35
|
显示全部楼层
本楼为最佳答案
- Sub Macro1()
- Dim arr, brr, w(0 To 9), d, i&, j%, k%
- Set d = CreateObject("scripting.dictionary")
- arr = Range("a1").CurrentRegion
- ReDim brr(1 To UBound(arr) - 1, 1 To 5)
- For i = 2 To UBound(arr)
- zf = arr(i, 2)
- For j = 1 To Len(zf)
- z = Mid(zf, j, 1)
- w(z) = z
- Next
- sz = Join(w, "")
- Erase w
- For k = 1 To Len(sz)
- s = Mid(sz, k, 1)
- If Not d.exists(s) Then
- d(s) = i - 2
- brr(i - 1, k) = d(s)
- Else
- If d(s) = i - 3 Then brr(i - 1, k) = 0 Else brr(i - 1, k) = i - 3 - d(s)
- d(s) = i - 2
- End If
- Next
- Next
- Range("d15").Resize(UBound(brr), 5) = brr
- End Sub
复制代码 |
|