stillfish00

1. Sub Test()
   
2.     Dim x, y
   
3.     Dim d As Object: Set d = CreateObject("scripting.dictionary")
   
4.     For Each x In [a1:a4]
   
5.         d.Add CStr(x), ""
   
6.     Next
   
7.    
   
8.     Dim ar: ar = d.Keys
   
9.     Dim bNew As Boolean
   
10.     Do
    
11.         bNew = False
    
12.         For Each x In d.Keys
    
13.             For Each y In ar
    
14.                 If Right(x, 1) < y And Not d.exists(x & y) Then
    
15.                     d.Add x & y, ""
    
16.                     bNew = True
    
17.                 End If
    
18.             Next
    
19.         Next
    
20.         DoEvents
    
21.     Loop While bNew
    
22.     [c1].Resize(d.Count) = Application.Transpose(d.Keys)
    
23. End Sub

½Æ»s¥N½X

¦^´_ 1# ikboy