GBKEE

¦^´_ 2# lpk187
¤@¦¸ªº°j°é

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Ar(), i As Integer
   
4.     With Range([B2], Range("b2").End(xlToRight).End(xlDown))
   
5.         ReDim Ar(1 To .Count, 1 To 2)
   
6.         For i = 1 To .Count
   
7.             Ar(i, 1) = .Cells(i).End(xlToLeft) & .Cells(i).End(xlUp)
   
8.             Ar(i, 2) = .Cells(i)
   
9.         Next
   
10.         .Cells(.Rows.Count + 2, 1).Resize(.Count, 2) = Ar
    
11.     End With
    
12. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 8# boblovejoyce
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, Ar1(), x As Integer, Ar2(), i As Integer
   
4.     Set Rng = [F1]
   
5.     Do While Rng <> ""
   
6.         i = 0
   
7.         If Mid(Rng, 1, 1) = Mid(Rng.Offset(i), 1, 1) Then
   
8.             ReDim Preserve Ar1(x + 1)
   
9.             ReDim Ar2(i)
   
10.             Ar2(i) = Mid(Rng, 1, 1)
    
11.             Do While Mid(Rng, 1, 1) = Mid(Rng.Offset(i), 1, 1)
    
12.                 i = i + 1
    
13.                 ReDim Preserve Ar2(i)
    
14.                 Ar2(i) = Rng.Offset(i - 1, 1)
    
15.             Loop
    
16.             Ar1(x + 1) = Ar2
    
17.             Set Rng = Rng.Offset(i)
    
18.             x = x + 1
    
19.         End If
    
20.     Loop
    
21.     ReDim Ar2(i)
    
22.     For i = 0 To i
    
23.         Ar2(i) = IIf(i > 0, i, "")
    
24.     Next
    
25.     Ar1(0) = Ar2
    
26.     For i = 0 To UBound(Ar1)
    
27.         [I1].Offset(i).Resize(, UBound(Ar1) + 1) = Ar1(i) '¤@¦æ¤@¦æªº¼g¤J
    
28.     Next
    
29.     '*********** ¤@¦¸¼g¤J
    
30.     [I1].Resize(UBound(Ar1) + 1, UBound(Ar2) + 1).Value = Application.Transpose(Application.Transpose(Ar1))
    
31. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 11# boblovejoyce

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, Ar1(), x As Integer, Ar2(), i As Integer
   
4.     Dim Y As Integer, S As String
   
5.     Set Rng = [F1]
   
6.     Do While Rng <> ""
   
7.         i = 0: Y = 1: S = ""
   
8.         While Mid(Rng, Y, 1) Like "[A-z]"  '¬O¦r¥À
   
9.             S = Mid(Rng, 1, Y)
   
10.             Y = Y + 1
    
11.         Wend
    
12.         If S <> "" And S = Mid(Rng.Offset(i), 1, Y - 1) Then
    
13.             ReDim Preserve Ar1(x + 1)
    
14.             ReDim Ar2(i)
    
15.             Ar2(i) = S
    
16.             Do While S = Mid(Rng.Offset(i), 1, Y - 1)
    
17.                 i = i + 1
    
18.                 ReDim Preserve Ar2(i)
    
19.                 Ar2(i) = Rng.Offset(i - 1, 1)
    
20.             Loop
    
21.             Ar1(x + 1) = Ar2
    
22.             Set Rng = Rng.Offset(i)
    
23.             x = x + 1
    
24.         End If
    
25.     Loop
    
26.     ReDim Ar2(i)
    
27.     For i = 0 To i
    
28.         Ar2(i) = IIf(i > 0, i, "")
    
29.     Next
    
30.     Ar1(0) = Ar2
    
31.    ' For i = 1 To UBound(Ar1)
    
32.    '     [I1].Offset(i).Resize(, UBound(Ar1(i)) + 1) = Ar1(i) '¤@¦æ¤@¦æªº¼g¤J
    
33.    ' Next
    
34.    '*********** ¤@¦¸¼g¤J
    
35.     [I1].Resize(UBound(Ar1) + 1, UBound(Ar2) + 1).Value = Application.Transpose(Application.Transpose(Ar1))
    
36. End Sub

½Æ»s¥N½X