|
发表于 2017-4-6 20:38
|
显示全部楼层
本楼为最佳答案
- Sub tt()
- Dim arr, d, i%, y%
- Range("d:e").Clear
- arr = Sheet1.Range("a2").CurrentRegion
- Set d = CreateObject("Scripting.Dictionary")
- For i = 2 To UBound(arr)
- If Not d.exists("'" & arr(i, 1)) Then
- d.Add "'" & arr(i, 1), arr(i, 2)
- ElseIf Not (d("'" & arr(i, 1)) Like "*" & arr(i, 2) & "*") Then
- d("'" & arr(i, 1)) = d("'" & arr(i, 1)) & "," & arr(i, 2)
- End If
- Next
- Range("d2").Resize(d.Count, 1) = Application.Transpose(d.keys)
- Range("e2").Resize(d.Count, 1) = Application.Transpose(d.items)
- Erase arr: Set d = Nothing
- End Sub
复制代码 |
|