如何自动合并Word文档段落内3个及以上的尾注为单个尾注？

你遇到的Paragraphs对象无直接Endnotes属性的问题，可以通过反向关联尾注所属段落的方式解决：每个尾注都有Reference属性，返回尾注上标标记对应的Range对象，该对象的Paragraphs(1)就是尾注所属的段落，我们可以通过遍历所有尾注先统计每个段落的尾注数量，再筛选符合条件的段落批量处理。

以下是可直接运行的完整宏代码：

Sub BatchMergeEndnotes()
    Dim doc As Document
    Dim endnote As Endnote
    Dim para As Paragraph
    Dim paraEndnoteCount As Object ' 用字典存储每个段落的尾注数量
    Dim paraList As Object ' 存储符合条件的段落
    Dim i As Integer, j As Integer, tmpText As String
    Dim paraKey As String
    
    Set doc = ActiveDocument
    Set paraEndnoteCount = CreateObject("Scripting.Dictionary")
    Set paraList = CreateObject("Scripting.Dictionary")
    
    ' 第一步：遍历所有尾注，统计每个段落的尾注数量
    For Each endnote In doc.Endnotes
        Set para = endnote.Reference.Paragraphs(1)
        ' 用段落的起始位置作为唯一标识key，避免重复识别
        paraKey = para.Range.Start
        If Not paraEndnoteCount.Exists(paraKey) Then
            paraEndnoteCount.Add paraKey, 1
            Set paraList(paraKey) = para
        Else
            paraEndnoteCount(paraKey) = paraEndnoteCount(paraKey) + 1
        End If
    Next endnote
    
    ' 第二步：筛选尾注数量≥3的段落，从后往前处理避免索引混乱
    Dim keys As Variant
    keys = paraEndnoteCount.keys
    For i = UBound(keys) To LBound(keys) Step -1
        paraKey = keys(i)
        If paraEndnoteCount(paraKey) >= 3 Then
            Set para = paraList(paraKey)
            tmpText = ""
            
            ' 收集该段落内所有尾注的内容
            For Each endnote In doc.Endnotes
                If endnote.Reference.Paragraphs(1).Range.Start = paraKey Then
                    If tmpText = "" Then
                        tmpText = endnote.Range.Text
                    Else
                        tmpText = tmpText & "; " & endnote.Range.Text
                    End If
                End If
            Next endnote
            
            ' 从后往前删除该段落内所有原有尾注
            For j = doc.Endnotes.Count To 1 Step -1
                If doc.Endnotes(j).Reference.Paragraphs(1).Range.Start = paraKey Then
                    doc.Endnotes(j).Delete
                End If
            Next j
            
            ' 在段落末尾添加合并后的尾注
            Dim insertPos As Range
            Set insertPos = para.Range
            insertPos.Collapse wdCollapseEnd ' 定位到段落末尾
            ' 调整位置到段落最后一个字符前，避免插入到段落标记外侧
            insertPos.MoveEnd wdCharacter, -1
            doc.Endnotes.Add Range:=insertPos, Text:=tmpText
        End If
    Next i
    
    ' 释放对象
    Set paraEndnoteCount = Nothing
    Set paraList = Nothing
    Set doc = Nothing
    MsgBox "尾注合并完成！"
End Sub

注意事项 #

• 运行前请务必备份原文档，防止批量操作失误造成内容丢失
• 绝大多数默认安装的Office都支持Scripting.Dictionary组件，如果你当前版本禁用了该组件，可将字典替换为数组存储段落标识
• 若需要调整合并的尾注数量阈值，只需修改If paraEndnoteCount(paraKey) >= 3 Then中的数字3即可

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