|
发表于 2016-6-2 09:28
|
显示全部楼层
本楼为最佳答案
- Sub tt()
- arr = [a1].CurrentRegion
- Set d = CreateObject("scripting.dictionary")
- For i = 2 To UBound(arr)
- x = arr(i, 1)
- If Not d.exists(x) Then
- d(x) = arr(i, 2)
- Else
- If InStr("," & d(x) & ",", "," & arr(i, 2) & ",") = 0 Then d(x) = d(x) & "," & arr(i, 2)
- End If
- Next
- [g2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
- End Sub
复制代码 |
|