[attach]35170[/attach]

請前輩試試看

Option Explicit
Sub test()
Dim Arr, i, x, T, j\$, c
Arr = Range([A1], [A65536].End(3))
For i = 1 To UBound(Arr)
j = Trim(Arr(i, 1))
c = Len(j)
For x = c To 2 Step -1
If UCase(Mid(j, x, 1)) Like "[A-Z]" Then
j = Trim(Mid(j, 1, x - 1)) & " " & Mid(j, x, c * 2)
End If
Next
Arr(i, 1) = j
Next
[B1].Resize(UBound(Arr), 1) = Arr
End Sub

Sub test()
Dim Arr, i, x, T, j\$, c
Arr = Range([A1], [A65536].End(3))
For i = 1 To UBound(Arr)
j = Trim(Arr(i, 1))
c = Len(j)
For x = c To 2 Step -1
T = UCase(Mid(j, x, 1))
If Asc(T) > 64 And Asc(T) < 123 Then
Arr(i, 1) = Replace(Arr(i, 1), T, " " & T)
End If
Next
Next
[B1].Resize(UBound(Arr), 1) = Arr
End Sub

[attach]35171[/attach]

[attach]35172[/attach]

s13030029 發表於 2022-8-25 08:38

Arr = Range([A1], [A65536].End(3)) 改成 Arr = [a1]，for 循環移除，還有...，可以試著改看看，有問題再提出，謝謝

https://blog.xuite.net/hcm19522/twblog/590513450

謝謝前輩發表此主題,請前輩再試試看

Option Explicit
Sub test4() '單列或多列都可以用
Dim Arr, i, x, j\$, c, d, xD, T
Arr = Range([A1], [A65536].End(3).Offset(1, 0))
Set xD = CreateObject("Scripting.Dictionary")
For d = 65 To 122 '65~90是大寫 97~122是小寫
xD(d) = Chr(d)
If d = 90 Then d = 96
Next
T = Join(xD.items, "//")
For i = 1 To UBound(Arr) - 1
j = Arr(i, 1)
j = Replace(Replace(j, " ", ""), "　", "") '去除空白字元
c = Len(j)
For x = c To 2 Step -1
If InStr(T, Mid(j, x, 1)) And Mid(j, x - 1, 1) <> vbLf Then
j = Mid(j, 1, x - 1) & " " & Mid(j, x, c * 2)
End If
Next
Arr(i, 1) = j
Next
[B1].Resize(UBound(Arr) - 1, 1) = Arr
Set Arr = Nothing
End Sub

s13030029 發表於 2022-8-25 10:29

Sub test()
Dim Arr, a, T, i&, x, j%
Arr = Range([A1], [A65536].End(3).Offset(1, 0))
For i = 1 To UBound(Arr) - 1
a = Split(Trim(Arr(i, 1)), Chr(10))
For x = 0 To UBound(a)
For j = 2 To Len(a(x))
T = UCase(Mid(a(x), j))
If Asc(T) > 64 And Asc(T) < 123 Then
If Cells(i, 2) = "" Then
Cells(i, 2) = Replace(a(x), T, " " & T)
Else
Cells(i, 2) = Cells(i, 2) & Chr(10) & Replace(a(x), T, " " & T)
End If
End If
Next
Next
Next
End Sub

If Mid(j, x, 1) Like "[A-z]" Then  大小通吃~~

謝謝 前輩指導

修正自己的認知
j = Trim(Mid(j, 1, x - 1)) & " " & Mid(j, x, c * 2) 改為
j = Trim(Mid(j, 1, x - 1)) & " " & Mid(j, x)即可

https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/mid-function
Mid(string, start, [ length ])
string        必要。 字串運算式的功能是會從中傳回字元。 如果 字串 包含 Null，則傳回 Null。
start        必要；Long。 string 中要擷取做為開始部分的字元位置。 如果 start 中的字元數大於 string，則 Mid 會傳回零長度字串 ("")。
length        選用；Variant (Long)。 要傳回的字元數。 如果省略此參數，或是字元數少於文字中的 length 字元 (包含 start 所在的字元)，就會傳回從 start 位置開始一直到字串結尾的所有字元。

 歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)