- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
12#
發表於 2015-7-3 20:08
| 只看該作者
回復 11# boblovejoyce - Option Explicit
- Sub Ex()
- Dim Rng As Range, Ar1(), x As Integer, Ar2(), i As Integer
- Dim Y As Integer, S As String
- Set Rng = [F1]
- Do While Rng <> ""
- i = 0: Y = 1: S = ""
- While Mid(Rng, Y, 1) Like "[A-z]" '是字母
- S = Mid(Rng, 1, Y)
- Y = Y + 1
- Wend
- If S <> "" And S = Mid(Rng.Offset(i), 1, Y - 1) Then
- ReDim Preserve Ar1(x + 1)
- ReDim Ar2(i)
- Ar2(i) = S
- Do While S = Mid(Rng.Offset(i), 1, Y - 1)
- i = i + 1
- ReDim Preserve Ar2(i)
- Ar2(i) = Rng.Offset(i - 1, 1)
- Loop
- Ar1(x + 1) = Ar2
- Set Rng = Rng.Offset(i)
- x = x + 1
- End If
- Loop
- ReDim Ar2(i)
- For i = 0 To i
- Ar2(i) = IIf(i > 0, i, "")
- Next
- Ar1(0) = Ar2
- ' For i = 1 To UBound(Ar1)
- ' [I1].Offset(i).Resize(, UBound(Ar1(i)) + 1) = Ar1(i) '一行一行的寫入
- ' Next
- '*********** 一次寫入
- [I1].Resize(UBound(Ar1) + 1, UBound(Ar2) + 1).Value = Application.Transpose(Application.Transpose(Ar1))
- End Sub
|
|
發表於 2015-7-3 19:19
| 
