求助：如何批量清除Word文档中的冗余连续空段落

方法1：优化查找替换（单次操作搞定） #

• 打开Word「查找和替换」对话框（快捷键Ctrl+H）
• 点击「更多」，勾选「使用通配符」选项
• 在「查找内容」输入框中填入：^p{2,}
• 在「替换为」输入框中填入：^p
• 点击「全部替换」，一次即可将所有2个及以上的连续空段落压缩为1个空段落

方法2：VBA宏单文档处理（稳定可靠） #

如果之前的VBA宏没生效，试试这个经过验证的代码：

Sub RemoveConsecutiveEmptyParagraphs()
    Dim doc As Document
    Set doc = ActiveDocument
    With doc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^p{2,}"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
    ' 若需彻底删除所有空段落（仅保留正常段落间隔），取消下方注释
    'With doc.Content.Find
    '    .Text = "^p"
    '    .Replacement.Text = ""
    '    .Execute Replace:=wdReplaceAll
    'End With
    MsgBox "连续空段落清理完成！", vbInformation
End Sub

• 使用步骤：打开目标Word文档，按Alt+F11打开VBA编辑器，插入新模块，粘贴上述代码，运行宏即可

方法3：VBA宏批量处理多文档 #

针对大量文档的批量需求，可使用以下宏：

Sub BatchRemoveEmptyParagraphs()
    Dim fd As FileDialog
    Dim filePath As Variant
    Dim doc As Document
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "选择需要处理的Word文档"
        .Filters.Add "Word格式文档", "*.docx;*.doc"
        .AllowMultiSelect = True
        If .Show = -1 Then
            For Each filePath In .SelectedItems
                Set doc = Documents.Open(filePath)
                RemoveConsecutiveEmptyParagraphs
                doc.Save
                doc.Close
            Next filePath
            MsgBox "批量处理完成！", vbInformation
        End If
    End With
    Set fd = Nothing
    Set doc = Nothing
End Sub

• 注意：运行前请备份所有待处理文档，避免数据意外

内容的提问来源于stack exchange，提问作者user2890690