使用VBA宏对比两个独立Excel文件对应列数据的实现咨询

• 前置配置：将20个场景对应的旧文件路径、新文件路径、表头所在行号统一存入数组，后续直接循环数组处理所有场景，避免重复编码
• 变量匹配：每个场景处理时，分别读取新旧文件的表头行，用字典存储「变量名-对应列号」的映射关系，可实现变量名的毫秒级匹配，不用逐列遍历查找
• 差异对比：仅筛选两个文件共有的变量做对比（新增变量可自行加逻辑单独标记），逐行读取对应列的数值对比，可设置浮点误差容限，避免四舍五入导致的误判
• 结果输出：将差异条目对应的行号、变量名、旧版本值、新版本值统一写入结果表，可按场景分sheet存储，也可所有场景差异汇总到同一张表

Sub 批量对比Excel差异()
    ' --------------- 提前修改以下参数 ----------------
    Const 表头行 As Integer = 1 ' 你的变量名所在的行号
    Const 允许误差 As Double = 0.0001 ' 浮点型数值允许的最大差异，避免四舍五入误判
    ' 20个场景的配置，格式为Array(旧文件路径, 新文件路径, 场景名称)
    Dim 场景配置 As Variant
    场景配置 = Array( _
        Array("C:\场景1\旧文件.xlsx", "C:\场景1\新文件.xlsx", "场景1"), _
        Array("C:\场景2\旧文件.xlsx", "C:\场景2\新文件.xlsx", "场景2") _
        ' 剩下的18个场景按上面的格式继续补充即可
    )
    ' ------------------------------------------------
    Dim 结果工作簿 As Workbook, 结果表 As Worksheet
    Dim 旧字典 As Object, 新字典 As Object, i As Long, j As Long
    Dim 旧文件 As Workbook, 新文件 As Workbook, 旧表 As Worksheet, 新表 As Worksheet
    Dim 最大行 As Long, 变量名 As String, 旧值, 新值, 差异行号 As Long
    
    ' 新建结果工作簿
    Set 结果工作簿 = Workbooks.Add
    Set 旧字典 = CreateObject("Scripting.Dictionary")
    Set 新字典 = CreateObject("Scripting.Dictionary")
    
    ' 循环处理20个场景
    For i = LBound(场景配置) To UBound(场景配置)
        ' 新建当前场景的结果表
        Set 结果表 = 结果工作簿.Sheets.Add(after:=结果工作簿.Sheets(结果工作簿.Sheets.Count))
        结果表.Name = 场景配置(i)(2)
        结果表.Range("A1:D1") = Array("行号", "变量名", "旧版本值", "新版本值")
        差异行号 = 2
        
        ' 打开新旧文件，默认取第一个工作表，有需要可以改成指定表名
        Set 旧文件 = Workbooks.Open(场景配置(i)(0), ReadOnly:=True)
        Set 旧表 = 旧文件.Sheets(1)
        Set 新文件 = Workbooks.Open(场景配置(i)(1), ReadOnly:=True)
        Set 新表 = 新文件.Sheets(1)
        
        ' 读取旧文件变量名和列号的映射
        旧字典.RemoveAll
        For j = 1 To 旧表.Cells(表头行, Columns.Count).End(xlToLeft).Column
            变量名 = Trim(旧表.Cells(表头行, j).Value)
            If 变量名 <> "" And Not 旧字典.Exists(变量名) Then 旧字典(变量名) = j
        Next j
        
        ' 读取新文件变量名和列号的映射
        新字典.RemoveAll
        For j = 1 To 新表.Cells(表头行, Columns.Count).End(xlToLeft).Column
            变量名 = Trim(新表.Cells(表头行, j).Value)
            If 变量名 <> "" And Not 新字典.Exists(变量名) Then 新字典(变量名) = j
        Next j
        
        ' 取两个文件的最大数据行，取大的那个
        最大行 = Application.WorksheetFunction.Max( _
            旧表.Cells(Rows.Count, 1).End(xlUp).Row, _
            新表.Cells(Rows.Count, 1).End(xlUp).Row _
        )
        
        ' 逐行逐共有变量对比
        For j = 表头行 + 1 To 最大行
            For Each 变量名 In 旧字典.Keys
                If 新字典.Exists(变量名) Then ' 仅对比共有变量
                    旧值 = 旧表.Cells(j, 旧字典(变量名)).Value
                    新值 = 新表.Cells(j, 新字典(变量名)).Value
                    ' 对比逻辑，处理空值和数值
                    If IsNumeric(旧值) And IsNumeric(新值) Then
                        If Abs(CDbl(旧值) - CDbl(新值)) > 允许误差 Then
                            结果表.Cells(差异行号, 1) = j
                            结果表.Cells(差异行号, 2) = 变量名
                            结果表.Cells(差异行号, 3) = 旧值
                            结果表.Cells(差异行号, 4) = 新值
                            差异行号 = 差异行号 + 1
                        End If
                    Else
                        If CStr(旧值) <> CStr(新值) Then
                            结果表.Cells(差异行号, 1) = j
                            结果表.Cells(差异行号, 2) = 变量名
                            结果表.Cells(差异行号, 3) = 旧值
                            结果表.Cells(差异行号, 4) = 新值
                            差异行号 = 差异行号 + 1
                        End If
                    End If
                End If
            Next 变量名
        Next j
        
        ' 关闭当前场景的新旧文件，不保存
        旧文件.Close SaveChanges:=False
        新文件.Close SaveChanges:=False
    Next i
    
    ' 保存结果文件到桌面
    结果工作簿.SaveAs Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Excel对比差异结果.xlsx"
    MsgBox "所有场景对比完成，结果已保存到桌面"
End Sub

• 代码用了字典后期绑定，不需要手动加引用，直接运行即可
• 如果你的变量不在第一个工作表，把Sheets(1)改成Sheets("你的表名")即可
• 如果需要标记新版本新增的变量，可以在代码里加遍历新字典key的逻辑，判断旧字典不存在的变量单独输出即可
• 对比前建议先备份原文件，避免误操作丢失数据

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