oobird

1. Sub yy()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     For i = 2 To UBound(arr)
   
5.         If Not d.exists(arr(i, 1)) Then
   
6.             d(arr(i, 1)) = arr(i, 2)
   
7.         Else
   
8.             d(arr(i, 1)) = d(arr(i, 1)) & "," & arr(i, 2)
   
9.         End If
   
10.     Next
    
11.     c = 6
    
12.     For Each k In d.keys
    
13.         d(k) = Split(d(k), ",")
    
14.         Cells(1, c) = k
    
15.         Cells(2, c).Resize(UBound(d(k)) + 1, 1) = Application.Transpose(d(k))
    
16.         c = c + 1
    
17.     Next
    
18. End Sub

½Æ»s¥N½X