【求助】如何通过VBA实现删除无用的回车及制表符等

Zhanghaijing87

各位大佬：
我在制作文档过程中，经常会遇到pdf转成word 的文档。格式非常不规范。想写个代码主要针对pdf转为word的不规范格式的文档。

因为我想选中范围内的内容实现以下效果：
1、首先把软回车和假的硬回车都替换为真回车。（pdf转的文档经常会有一些换行符和假回车）
2、再把多个回车替换成一个回车。（这个可以一步实现。因为我不会，所以我分多步替换的）
3、把不该是回车的回车删掉。（有一些一段话被拆掉了，所以不是结尾的回车要删掉，我下面这个代码只实现了这一步。前两步，通过录制宏改的但是运行完不知道为什么缺没有结果）
4、是我调整格式备用的，把所有空格和制表符删掉，我也给加上来了。放在这里一起实现，但是也是运行完了没有结果
以下是我通过录制宏改的代码，但是是有3实现了。。其他的都没有变化。请大佬帮我改一下，感谢感谢：


Sub 删除无用回车制表符等()
If Selection.Type = wdSelectionIP Then
    MsgBox "请选择内容范围。"
Else

    With Selection.Find
        .ClearFormatting
        .text = "^11"
        .Replacement.text = "^p"
        .text = "^13"
        .Replacement.text = "^p"
        .text = "[^13]{1,}"
        .Replacement.text = "^p"
        .text = "([!。；！？" & ChrW(8221) & "])^13"
        .Replacement.text = "\1"
        .text = vbTab
        .Replacement.text = "" '删除多个制表符
        .text = " "
        .Replacement.text = "" '删除多个空格
        .Forward = True      '找方向：向前
        .Format = False     '考虑格式
        .MatchCase = False     '区分大小写
        .MatchWholeWord = False     '匹配整个单词
        .MatchByte = False       '区分全角半角
        .CorrectHangulEndings = False        '修正韩语结尾
        .HanjaPhoneticHangul = False       '处理韩语语音和韩语
        .MatchAllWordForms = False        '匹配所有单词形式
        .MatchSoundsLike = False        '进行发音相似匹配
        .MatchWildcards = True        '用通配符匹配
    End With
    Selection.Find.Execute Replace:=wdReplaceAll    '行查找和替换操作，全部替换
End If
End Sub

Zhanghaijing87

刚才发现，一个with循环里面，他只能干一件事。不能在一个with里面进行多个替换。因此我重新录制修改了一下，不知道运行速度是否合理。代码是否合理。但是发上来各位大佬可以帮忙看看。。感谢老师们：
以下代码。刚才在我的文档内测试可以顺利运行。如果有不妥之处还望大佬们指点一二。感谢感谢：

Sub 删除无用回车()
If Selection.Type = wdSelectionIP Then
    MsgBox "请选择内容范围。"
Else
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .text = "[^11^13]{1,}"
        .Replacement.text = "^13"
        .Forward = True      '找方向：向前
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find
        .ClearFormatting
        .text = "([!。；！？" & ChrW(8221) & "])^13"
        .Replacement.text = "\1"
        .Forward = True      '找方向：向前
        .MatchWildcards = True        '用通配符匹配
    End With
    Selection.Find.Execute Replace:=wdReplaceAll    '行查找和替换操作，全部替换
End If
End Sub
Sub 删除制表位与空格()
If Selection.Type = wdSelectionIP Then
    MsgBox "请选择内容范围。"
Else

  Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .text = vbTab
        .Replacement.text = ""
        .Forward = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    With Selection.Find
        .text = " "
        .Replacement.text = ""
        .Forward = True
          End With
    Selection.Find.Execute Replace:=wdReplaceAll
End If

End Sub

413191246se

楼主，请下载压缩包，解压到 D 盘根下，再在 Word 中按 Alt + F11，再按 Ctrl + M 导入 M0820.bas
打开测试文档，按 Alt + F8 打开宏名列表，找到 a0820_TextCheck 宏，运行之。
M0820.rar (452 Bytes, 下载次数: 12)

2024-8-20 20:10 上传

点击文件名下载附件

413191246se

还有，楼主 可以提供一个示例附件，这样更好。

Zhanghaijing87

413191246se 发表于 2024-8-20 20:11
楼主，请下载压缩包，解压到 D 盘根下，再在 Word 中按 Alt + F11，再按 Ctrl + M 导入 M0820.bas
打开测 ...

好的。谢谢老师

Zhanghaijing87

413191246se 发表于 2024-8-20 20:12
还有，楼主 可以提供一个示例附件，这样更好。

嗯。下次记得了。