[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  大小通吃~~

謝謝 前輩指導

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