删除半角空格，保留英文间的空格的vba？

1478525

删除半角空格，保留英文间的空格的vba，这个代码太慢了，应该是用哪种方法可以，求大佬赐教
Sub 清除非英文间空格()
    Dim rng As Range
    Dim i As Long
    Dim text As String
    Dim prevChar As String
    Dim nextChar As String


    ' 设置应用范围，这里以整个文档为例
    Set rng = ActiveDocument.Content


    ' 禁用屏幕更新和撤销记录以提高宏的执行效率
    Application.ScreenUpdating = False
    Application.UndoRecord.StartCustomRecord "清除非英文间空格"


    ' 遍历文档中的每个字符
    For i = rng.Characters.Count To 1 Step -1
        ' 获取当前字符
        text = rng.Characters(i).Text
        ' 检查前一个字符和后一个字符（如果存在的话）
        If i > 1 Then
            prevChar = rng.Characters(i - 1).Text
        Else
            prevChar = ""
        End If
        If i < rng.Characters.Count Then
            nextChar = rng.Characters(i + 1).Text
        Else
            nextChar = ""
        End If


        ' 判断是否为英文单词间的空格
        If (text Like " ") And (prevChar Like "[A-Za-z]") And (nextChar Like "[A-Za-z]") Then
            ' 保留英文单词间的半角空格
        Else
            ' 删除半角空格、不间断空格和全角空格
            If text Like " " Or text Like ChrW(160) Or text Like ChrW(12288) Then
                rng.Characters(i).Delete
            End If
        End If
    Next i


    ' 重新启用屏幕更新和结束撤销记录
    Application.UndoRecord.EndCustomRecord
    Application.ScreenUpdating = True


    ' 清除变量
    Set rng = Nothing
End Sub

vbee

思路：选择所有中文。查找空格替换。

1478525

vbee 发表于 2024-7-11 18:15
思路：选择所有中文。查找空格替换。

只有这种办法吗，感觉这样的，会很慢 而且还有数字的？

vbee

所有中文汉字和中文标点 间的空格删除

过客fppt

1478525 发表于 2024-7-11 19:17
只有这种办法吗，感觉这样的，会很慢 而且还有数字的？

是这个方法比较快，不过你弄的时候录制一个宏，然后修改一下.find的方法里面的参数，后面直接运行宏就可以自动查找替换了

1478525

vbee 发表于 2024-7-11 20:52
所有中文汉字和中文标点 间的空格删除

好的谢谢我试试

413191246se

no..........

413191246se

1. Sub a0712_DeleteSpace_Update()
   
2.     Dim l!
   
3.     l = Timer
   
4.     With ActiveDocument.Content.Find
   
5.         .Execute "^l", , , 0, , , , , , "^p", 2
   
6.         .Execute "(^13)([ 　^s^t]{1,})", , , 1, , , , , , "\1", 2
   
7.         .Execute "([ 　^s^t]{1,})(^13)", , , 1, , , , , , "\2", 2
   
8.         .Execute "[ 　^s^t]{1,}", , , 1, , , , , , " ", 2
   
9.         .Execute "([.:;,\!\?])([a-zA-Z0-9ａ-ｚＡ-Ｚ０-９])", , , 1, , , , , , "\1 \2", 2
   
10.         .Execute "( )([.:;,\!\?])", , , 1, , , , , , "\2", 2
    
11.         .Execute "([!^1-^127])( )", , , 1, , , , , , "\1", 2
    
12.         .Execute "( )([!^1-^127])", , , 1, , , , , , "\2", 2
    
13.     End With
    
14.     MsgBox "Complete!" & vbCr & "Cost-Time = " & Round(Timer - l, 2) & " Seconds.", 0 + 48
    
15. End Sub

复制代码

诡天翼1988

WPS里有删除空格功能，会保留英文单词之间的空格， 免费使用

1478525

413191246se 发表于 2024-7-12 02:18

谢谢，很好用的，目前感觉没有问题