我来帮你搞定这个问题！你的核心需求是找出文档里完全加粗的段落（比如副标题），并且删除它们紧随的空行对吧？先看看你现有代码的几个问题：

1. 错误使用了Selection.Font.Bold：这个属性是检查当前选中内容的加粗状态，不是整个段落里所有文本的格式，所以不管段落是不是全加粗，都会触发判断（而且你代码里没限定选中范围，相当于每次循环都检查当前光标位置的格式，根本没用到para对象）
2. 代码结构有问题：Else:后面没有对应的End If，循环逻辑混乱，导致每个段落都会执行一次MsgBox

下面是修正后的完整代码，完全符合你的需求：

Sub FindAndProcessBoldParagraphs()
    Dim para As Paragraph
    Dim isAllBold As Boolean
    Dim char As Range
    
    '遍历文档中所有段落
    For Each para In ActiveDocument.Paragraphs
        isAllBold = True '先默认当前段落是全加粗状态
        
        '逐个检查段落内的每个字符（跳过最后一个段落标记）
        For Each char In para.Range.Characters
            '段落标记的位置是para.Range.End - 1，跳过它避免干扰判断
            If char.Start < para.Range.End - 1 Then
                '只要有一个字符不是加粗，就标记为非全加粗并跳出循环
                If char.Font.Bold <> True Then
                    isAllBold = False
                    Exit For
                End If
            End If
        Next char
        
        '如果确认是全加粗段落
        If isAllBold Then
            MsgBox "找到全加粗段落：" & Left(para.Range.Text, Len(para.Range.Text) - 1) '去掉段落标记显示内容
            '检查下一个段落是否存在，并且是空行
            If para.Index < ActiveDocument.Paragraphs.Count Then
                Dim nextPara As Paragraph
                Set nextPara = ActiveDocument.Paragraphs(para.Index + 1)
                '空行的特征是段落内容只有一个段落标记（长度为1）
                If Len(nextPara.Range.Text) = 1 Then
                    nextPara.Range.Delete '删除空行
                End If
            End If
        End If
    Next para
End Sub

代码关键点说明： #

• 全加粗判断逻辑：先假设段落是全加粗，再逐个检查每个字符（跳过段落标记，因为很多时候段落标记不会被设置加粗），只要发现一个非加粗字符就立即终止检查，提升效率
• 空行删除逻辑：找到全加粗段落后，判断下一个段落是否为空行（通过段落文本长度是否为1来判断，因为空行只有一个段落标记），是的话直接删除
• 友好提示：MsgBox里显示的是去掉段落标记的段落内容，方便你确认找到的是不是目标段落

额外优化建议： #

如果你的加粗段落是用统一的样式设置的（比如「标题2」样式），可以直接通过样式判断，比逐个字符检查高效得多，代码可以简化成：

Sub FindStyledBoldParagraphs()
    Dim para As Paragraph
    For Each para In ActiveDocument.Paragraphs
        '替换成你实际使用的加粗标题样式名称
        If para.Style = "标题2" Then
            MsgBox "找到样式为标题2的段落：" & Left(para.Range.Text, Len(para.Range.Text) - 1)
            '同样的空行删除逻辑
            If para.Index < ActiveDocument.Paragraphs.Count Then
                Dim nextPara As Paragraph
                Set nextPara = ActiveDocument.Paragraphs(para.Index + 1)
                If Len(nextPara.Range.Text) = 1 Then
                    nextPara.Range.Delete
                End If
            End If
        End If
    Next para
End Sub

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