|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Option Explicit
- Sub test()
- Dim Dic, arr1, x, arr2, arr3, arr4(1 To 10000, 1 To 3)
- Set Dic = CreateObject("Scripting.Dictionary")
- arr1 = Range("A1").CurrentRegion
- For x = 2 To UBound(arr1)
- If Not Dic.exists(arr1(x, 1)) Then
- Dic(arr1(x, 1)) = arr1(x, 2)
- Else
- Dic(arr1(x, 1)) = Dic(arr1(x, 1)) & "," & arr1(x, 2)
- End If
- Next x
- arr3 = Dic.keys
- arr2 = Dic.items
- For x = 1 To Dic.Count
- arr4(x, 1) = arr3(x - 1)
- arr4(x, 2) = Split(arr2(x - 1), ",")(1)
- arr4(x, 3) = Split(arr2(x - 1), ",")(2)
- Next x
- Range("D1").CurrentRegion.Clear
- [D1] = "????": [E1] = "????1": [F1] = "????2"
- [d2].Resize(Dic.Count, 3) = arr4
- Range("D1").CurrentRegion.EntireColumn.AutoFit
- Range("D1").CurrentRegion.Borders.LineStyle = 1
- End Sub
- Sub ???()
- Range("D1").CurrentRegion.Clear
- End Sub
复制代码 |
|