求基于VBA或Office内置工具的Word文档差异对比提取方案

一、使用Word内置比较工具（无需代码） #

Word自带的对比功能可以快速标记文档差异，后续可整理为表格：

• 打开Word，点击「审阅」选项卡 → 「比较」→ 「比较」
• 在弹窗中选择「原文档」和「修订文档」，点击确定生成对比文档
• 对比文档会用颜色标记新增、删除、修改的内容，可通过「审阅」→「显示标记」筛选需要的差异类型
• 手动将筛选后的差异按「差异类型」「原内容」「新内容」「位置」的列项，复制粘贴到新建表格中

二、VBA自动提取差异到表格 #

以下是可直接运行的VBA代码，能自动完成对比并生成差异表格：

1. 打开Word，按Alt + F11打开VBA编辑器
2. 右键左侧项目 → 「插入」→「模块」，粘贴以下代码：

Sub CompareDocsAndExtractDiffToTable()
    Dim docOriginal As Document, docRevised As Document, docResult As Document
    Dim tbl As Table, rev As Revision
    Dim i As Integer
    
    ' 选择原文档与修订文档
    Set docOriginal = Application.Documents.Open(Application.GetOpenFilename("Word Documents (*.docx;*.doc), *.docx;*.doc"))
    Set docRevised = Application.Documents.Open(Application.GetOpenFilename("Word Documents (*.docx;*.doc), *.docx;*.doc"))
    
    ' 创建结果文档
    Set docResult = Documents.Add
    docResult.Content.InsertBefore("文档差异对比结果" & vbCrLf & vbCrLf)
    
    ' 初始化差异表格
    Set tbl = docResult.Tables.Add(docResult.Content, 1, 4)
    tbl.Cell(1, 1).Range.Text = "差异类型"
    tbl.Cell(1, 2).Range.Text = "原内容"
    tbl.Cell(1, 3).Range.Text = "新内容"
    tbl.Cell(1, 4).Range.Text = "所在段落"
    tbl.Rows(1).Bold = True
    
    i = 2
    ' 遍历所有修订标记
    For Each rev In docRevised.Revisions
        tbl.Rows.Add
        ' 判断差异类型并填充内容
        Select Case rev.Type
            Case wdRevisionInsert
                tbl.Cell(i, 1).Range.Text = "新增"
                tbl.Cell(i, 3).Range.Text = rev.Range.Text
            Case wdRevisionDelete
                tbl.Cell(i, 1).Range.Text = "删除"
                tbl.Cell(i, 2).Range.Text = rev.Range.Text
            Case wdRevisionReplace
                tbl.Cell(i, 1).Range.Text = "修改"
                tbl.Cell(i, 2).Range.Text = rev.Range.Text
                tbl.Cell(i, 3).Range.Text = rev.Range.Next.Text
        End Select
        ' 填充段落位置信息
        tbl.Cell(i, 4).Range.Text = Left(rev.Range.Paragraphs(1).Range.Text, 50) & "..."
        i = i + 1
    Next rev
    
    ' 自动调整表格列宽
    tbl.AutoFitBehavior wdAutoFitWindow
    
    ' 关闭原文档（不保存修改）
    docOriginal.Close SaveChanges:=wdDoNotSaveChanges
    docRevised.Close SaveChanges:=wdDoNotSaveChanges
    
    MsgBox "差异提取完成，结果已生成新文档！", vbInformation
End Sub

3. 按F5运行代码，按提示选择原文档和修订文档，即可自动生成带差异表格的新文档

代码说明： #

• 支持识别「新增」「删除」「修改」三类内容差异
• 表格包含差异类型、原内容、新内容、所在段落四个字段
• 运行过程中不会修改原文档，仅生成结果文档

三、注意事项 #

• 确保两个文档格式尽可能一致，避免格式差异干扰修订识别
• 若无需提取格式差异，可在运行代码前，通过「审阅」→「显示标记」取消勾选「格式」
• 首次运行需启用宏：文件 → 选项 → 信任中心 → 信任中心设置 → 宏设置 → 启用所有宏（仅信任文档中运行）

内容的提问来源于stack exchange，提问作者Aušra G