oobird

1. Sub test()
   
2.     Dim d As Object, a, b(100), m%, i%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     a = Range([a1], [b65536].End(3))
   
5.     ReDim arr(1 To UBound(a), 1 To UBound(a))
   
6.     For i = 1 To UBound(a)
   
7.         If Not d.exists(a(i, 1)) Then
   
8.             m = m + 1
   
9.             d(a(i, 1)) = m
   
10.             arr(m, 1) = a(i, 1): arr(m, 2) = a(i, 2): b(m) = 2
    
11.         Else
    
12.             b(m) = b(m) + 1
    
13.             arr(d(a(i, 1)), b(m)) = a(i, 2)
    
14.             x = IIf(b(m) > x, b(m), x)
    
15.         End If
    
16.     Next
    
17.     If x > 2 Then
    
18.         For i = 3 To x
    
19.             arr(1, i) = arr(1, 2)
    
20.         Next
    
21.     End If
    
22.     [d1].Resize(m, x) = arr
    
23. End Sub

½Æ»s¥N½X