|
- Sub test()
- Dim arr, d As Object, i&, j&
- Application.ScreenUpdating = False
- arr = [a1:b12]
- Set d = CreateObject("scripting.dictionary")
- For i = 1 To UBound(arr)
- If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
- d(arr(i, 1))(arr(i, 2)) = ""
- Next i
- Cells(4, 5).Resize(1, d.Count) = d.keys()
- For i = 0 To d.Count - 1
- For j = 0 To d.items()(i).Count - 1
- Cells(j + 5, i + 5) = d.items()(i).keys()(j)
- Next j
- Next i
- Application.ScreenUpdating = True
- Set d = Nothing
- End Sub
复制代码 |
|