如何用VBA删除Word中无内容的子标题（保留有效父标题）

需删除Word文档中无后续内容的子标题，规则如下：

• 若某标题下存在有效内容（非标题段落），则其所有父标题必须保留
• 仅删除那些自身及下属所有子标题都没有后续内容的空分支标题

1. Test Data (U)
1.1 Requirements
1.1.1   Test Requirements
1.1.1.1 Safety
1.1.1.1.1 Voltage incl. Monitoring
1.2    New Requirements
1.2.1 New test requirements
Test data which is used to write requirements

1. Test Data (U)
1.1    New Requirements
1.1.1 New test requirements
Test data which is used to write requirements

原代码会不分层级删除所有后续紧跟标题的标题，无法保留有内容分支的父标题：

Sub CleanupHeadings()

    Dim p As Paragraph
    Dim pNext As Paragraph

    For Each p In ActiveDocument.Paragraphs
        If IsHeading(p) Then
            ' check the following paragraph
            Set pNext = p.Next
            If Not pNext Is Nothing Then
                If IsHeading(pNext) Then
                    ' next paragraph is a heading too, so delete current paragraph
                    p.Range.Delete
                End If
            Else
                ' no following paragraph, i.e. document ends with a heading
                p.Range.Delete
            End If
        End If
    Next

End Sub

Function IsHeading(para As Paragraph) As Boolean

    IsHeading = para.OutlineLevel < wdOutlineLevelBodyText

End Function

以下代码从文档末尾往前遍历，精准判断每个标题是否属于无内容的空分支，仅删除符合条件的子标题：

Sub CleanupEmptySubHeadings()
    Dim p As Paragraph
    Dim currentLevel As Integer
    Dim hasContent As Boolean
    Dim i As Long
    
    ' 从后往前遍历段落，避免删除后索引混乱
    For i = ActiveDocument.Paragraphs.Count To 1 Step -1
        Set p = ActiveDocument.Paragraphs(i)
        If IsHeading(p) Then
            currentLevel = p.OutlineLevel
            hasContent = False
            ' 检查当前标题之后的段落，直到遇到更高层级的标题或文档末尾
            Dim j As Long
            For j = i + 1 To ActiveDocument.Paragraphs.Count
                Dim nextPara As Paragraph
                Set nextPara = ActiveDocument.Paragraphs(j)
                If IsHeading(nextPara) Then
                    ' 遇到更高层级的标题，停止检查
                    If nextPara.OutlineLevel < currentLevel Then
                        Exit For
                    End If
                Else
                    ' 发现非标题内容，说明当前标题有有效内容
                    hasContent = True
                    Exit For
                End If
            Next j
            ' 如果没有有效内容，删除当前标题
            If Not hasContent Then
                p.Range.Delete
            End If
        End If
    Next i
End Sub

Function IsHeading(para As Paragraph) As Boolean
    IsHeading = para.OutlineLevel < wdOutlineLevelBodyText
End Function

代码逻辑说明 #

1. 从后往前遍历：避免删除段落导致后续段落索引混乱，确保每个段落都能被正确检查
2. 层级判断：对于每个标题，检查其后续段落直到遇到更高层级的标题（父标题级别）
3. 内容检测：在上述范围内，只要发现非标题段落，就判定该标题有有效内容并保留；否则删除该空分支标题

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