Hsieh

1. Sub ex()
   
2. Dim Ar(), a, s%
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Set d1 = CreateObject("Scripting.Dictionary")
   
5. Set d2 = CreateObject("Scripting.Dictionary")
   
6. 
   
7. For Each a In Range([B2], [B65536].End(xlUp))
   
8.    d(a & a.Offset(, 1)) = d.Count
   
9.    If IsEmpty(d1(a.Offset(, 1).Value)) Then
   
10.       d1(a.Offset(, 1).Value) = a
    
11.    ElseIf a < d1(a.Offset(, 1).Value) Then
    
12.       d1(a.Offset(, 1).Value) = a
    
13.    End If
    
14.    If IsEmpty(d2(a.Offset(, 1).Value)) Then
    
15.       d2(a.Offset(, 1).Value) = a
    
16.    ElseIf a > d2(a.Offset(, 1).Value) Then
    
17.       d2(a.Offset(, 1).Value) = a
    
18.    End If
    
19. Next
    
20. For Each a In d1.keys
    
21.   For i = d1(a) To d2(a)
    
22.   If d.exists(i & a) = False Then
    
23.      ReDim Preserve Ar(s)
    
24.      Ar(s) = Array(i, a)
    
25.      s = s + 1
    
26.   End If
    
27.   Next
    
28. Next
    
29. [E2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    
30. [F2].Resize(d1.Count, 1) = Application.Transpose(d1.items)
    
31. [G2].Resize(d1.Count, 1) = Application.Transpose(d2.items)
    
32. [I2].Resize(s, 2) = Application.Transpose(Application.Transpose(Ar))
    
33. End Sub

½Æ»s¥N½X