boblovejoyce

回復 9# GBKEE

謝謝G大
不過真如樓上所說的,若有AA1,AM1這樣的字眼的時候
就會出現型態不符合

我快速抓了一份資訊,如附件,轉換的時候
會出現型態不符合

    test0703.rar (22.26 KB)

下載次數: 7

2015-7-3 19:17

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]"  '是字母
   
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) '一行一行的寫入
    
33.    ' Next
    
34.    '*********** 一次寫入
    
35.     [I1].Resize(UBound(Ar1) + 1, UBound(Ar2) + 1).Value = Application.Transpose(Application.Transpose(Ar1))
    
36. End Sub

複製代碼

lpk187

回復 12# GBKEE


    感謝G大解惑！謝謝！