Hsieh

¦^´_ 1# hu0318s
°ò¥»¾Þ§@¤ñ¸ûÁcÂø
¥ÎVBA»²§U§a

1. Sub ¨ú®ø´«¦æ()
   
2. Dim A As Range, ar()
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4. With ActiveSheet
   
5. k = .Range(.[A1], .[A1].End(xlToRight)).Count
   
6. For Each A In .Columns("A:A").SpecialCells(xlCellTypeConstants)
   
7. ReDim ar(k)
   
8.   For i = 0 To k - 1
   
9.      ar(i) = Split(A.Offset(, i), Chr(10))
   
10.   Next
    
11.   dic(A.Value) = ar
    
12.   Erase ar
    
13. Next
    
14. .Cells.ClearContents
    
15. r = 1: t = 1
    
16. For Each ky In dic.keys
    
17.    For i = 0 To k - 1
    
18.    ay = dic(ky)
    
19.    t = IIf(UBound(ay(i)) + 1 > t, UBound(ay(i)) + 1, t)
    
20.    .Cells(r, 1).Offset(, i).Resize(UBound(ay(i)) + 1, 1) = Application.Transpose(ay(i))
    
21.    Next
    
22.    r = r + t
    
23. Next
    
24. End With
    
25. End Sub

½Æ»s¥N½X

¦X¨ÖÀx¦s®æ.zip (21.53 KB)

¤U¸ü¦¸¼Æ: 6

2017-9-14 11:24