寻求仅对比两个Word文档中数字的Word VBA代码

下面这段VBA代码可以帮你实现需求：只对比英文原文档和翻译版文档里的数字数值，完全忽略非数字文本，同时保留所有原文内容，还会把两边数字不一致的地方用黄色底纹高亮标记出来。

Sub CompareDocumentNumbers()
    Dim docOriginal As Document, docTranslated As Document
    Dim rngOriginal As Range, rngTranslated As Range
    Dim colNumbersOriginal As Collection, colNumbersTranslated As Collection
    Dim i As Integer, numOriginal As Double, numTranslated As Double
    Dim strNum As String
    
    ' 选择原文档和翻译文档
    Set docOriginal = Application.GetOpenFilename(FileFilter:="Word Documents (*.docx;*.doc), *.docx;*.doc", Title:="选择英文原文档")
    If docOriginal Is Nothing Then Exit Sub
    Set docOriginal = Documents.Open(docOriginal)
    
    Set docTranslated = Application.GetOpenFilename(FileFilter:="Word Documents (*.docx;*.doc), *.docx;*.doc", Title:="选择翻译版文档")
    If docTranslated Is Nothing Then
        docOriginal.Close SaveChanges:=False
        Exit Sub
    End If
    Set docTranslated = Documents.Open(docTranslated)
    
    ' 初始化存储数字的集合
    Set colNumbersOriginal = New Collection
    Set colNumbersTranslated = New Collection
    
    ' 提取原文档中的所有数字（含小数、千分位格式）
    Set rngOriginal = docOriginal.Content
    With rngOriginal.Find
        .ClearFormatting
        .Text = "[0-9.,]+"
        .MatchWildcards = True
        .Forward = True
        .Wrap = wdFindStop
        Do While .Execute
            ' 处理千分位逗号，转换为可计算的数值字符串
            strNum = Replace(rngOriginal.Text, ",", "")
            If IsNumeric(strNum) Then
                colNumbersOriginal.Add Array(rngOriginal.Duplicate, CDbl(strNum))
            End If
        Loop
    End With
    
    ' 提取翻译文档中的所有数字
    Set rngTranslated = docTranslated.Content
    With rngTranslated.Find
        .ClearFormatting
        .Text = "[0-9.,]+"
        .MatchWildcards = True
        .Forward = True
        .Wrap = wdFindStop
        Do While .Execute
            strNum = Replace(rngTranslated.Text, ",", "")
            If IsNumeric(strNum) Then
                colNumbersTranslated.Add Array(rngTranslated.Duplicate, CDbl(strNum))
            End If
        Loop
    End With
    
    ' 对比数字数量
    If colNumbersOriginal.Count <> colNumbersTranslated.Count Then
        MsgBox "警告：两个文档中的数字数量不一致！原文档有 " & colNumbersOriginal.Count & " 个数字，翻译文档有 " & colNumbersTranslated.Count & " 个数字。", vbExclamation
    End If
    
    ' 逐个对比数字数值，标记差异
    For i = 1 To Application.Min(colNumbersOriginal.Count, colNumbersTranslated.Count)
        numOriginal = colNumbersOriginal(i)(1)
        numTranslated = colNumbersTranslated(i)(1)
        
        If numOriginal <> numTranslated Then
            ' 高亮原文档中的差异数字
            colNumbersOriginal(i)(0).HighlightColorIndex = wdYellow
            ' 高亮翻译文档中的差异数字
            colNumbersTranslated(i)(0).HighlightColorIndex = wdYellow
        End If
    Next i
    
    MsgBox "数字对比完成！", vbInformation
    
    ' 可选：保存对比后的文档（取消注释启用）
    ' docOriginal.SaveAs2 docOriginal.Path & "\原文档_数字对比标记版.docx"
    ' docTranslated.SaveAs2 docTranslated.Path & "\翻译文档_数字对比标记版.docx"
End Sub

关键说明： #

• 运行代码后会弹出对话框，让你依次选择原文档和翻译文档，无需手动修改路径
• 支持匹配带千分位逗号（如1,234）和小数（如56.78）的数字，自动处理格式转换后对比数值
• 仅高亮数值不一致的数字，非数字内容完全保留原样
• 若两个文档的数字总数不同，会先弹出警告提示

使用方法：打开Word，按Alt+F11打开VBA编辑器，插入新模块，粘贴代码后运行即可。

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