自动化对比两个Excel工作簿的VBA实现方案咨询

功能实现说明 #

以下代码可完成两个工作簿的金额校验：先对比D列金额总和，不匹配时按A列Type分组对比并高亮差异行，最后自动生成透视表报告展示差异。

核心代码模块 #

1. 主程序：总和校验与流程触发 #

Sub CompareWorkbooks()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim sum1 As Double, sum2 As Double
    
    ' 替换为你的目标工作簿路径
    Set wb1 = Workbooks.Open("C:\YourPath\Workbook1.xlsx")
    Set wb2 = Workbooks.Open("C:\YourPath\Workbook2.xlsx")
    Set ws1 = wb1.Sheets(1) ' 按需修改工作表序号/名称
    Set ws2 = wb2.Sheets(1)
    
    ' 获取数据最后一行（跳过表头，假设表头在第1行）
    lastRow1 = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
    
    ' 计算D列金额总和
    sum1 = Application.WorksheetFunction.Sum(ws1.Range("D2:D" & lastRow1))
    sum2 = Application.WorksheetFunction.Sum(ws2.Range("D2:D" & lastRow2))
    
    ' 总和对比（用极小值避免浮点精度误差）
    If Abs(sum1 - sum2) < 0.0001 Then
        MsgBox "两个工作簿D列金额总和匹配！"
        wb2.Close SaveChanges:=False
        wb1.Close SaveChanges:=False
        Exit Sub
    Else
        MsgBox "总和不匹配，开始按Type分组对比..."
        Call CompareByType(ws1, ws2, lastRow1, lastRow2)
        Call GeneratePivotReport(ws1, ws2)
    End If
End Sub

2. 按Type分组对比并高亮差异 #

Sub CompareByType(ws1 As Worksheet, ws2 As Worksheet, lastRow1 As Long, lastRow2 As Long)
    Dim typeDict As Object
    Dim cell As Range, matchCell As Range
    Dim typeVal As String, amt1 As Double, amt2 As Double
    
    Set typeDict = CreateObject("Scripting.Dictionary")
    
    ' 先把第二个工作簿的Type与对应金额存入字典
    For Each cell In ws2.Range("A2:A" & lastRow2)
        typeVal = cell.Value
        amt2 = cell.Offset(0, 3).Value ' D列对应偏移3列
        If typeDict.Exists(typeVal) Then
            typeDict(typeVal) = typeDict(typeVal) + amt2
        Else
            typeDict.Add typeVal, amt2
        End If
    Next cell
    
    ' 遍历第一个工作簿，对比并高亮差异行
    For Each cell In ws1.Range("A2:A" & lastRow1)
        typeVal = cell.Value
        amt1 = cell.Offset(0, 3).Value
        If typeDict.Exists(typeVal) Then
            If Abs(amt1 - typeDict(typeVal)) >= 0.0001 Then
                cell.EntireRow.Interior.Color = RGB(255, 204, 204) ' 浅红高亮
            End If
            typeDict.Remove typeVal ' 匹配后移除，剩余为wb2独有的Type
        Else
            cell.EntireRow.Interior.Color = RGB(255, 204, 204) ' wb1独有的Type也高亮
        End If
    Next cell
    
    ' 处理wb2中独有的Type，高亮对应行
    For Each typeVal In typeDict.Keys
        Set matchCell = ws2.Range("A:A").Find(typeVal, LookIn:=xlValues, LookAt:=xlWhole)
        If Not matchCell Is Nothing Then
            matchCell.EntireRow.Interior.Color = RGB(255, 204, 204)
        End If
    Next typeVal
End Sub

3. 自动生成透视表对比报告 #

Sub GeneratePivotReport(ws1 As Worksheet, ws2 As Worksheet)
    Dim pivotWs As Worksheet
    Dim pivotCache As PivotCache
    Dim pivotTable As PivotTable
    Dim sourceRange As Range
    Dim lastRow As Long
    
    ' 创建新工作表存放透视表
    Set pivotWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    pivotWs.Name = "金额对比报告"
    
    ' 合并两个工作表的Type与金额数据（临时复制到新表）
    ws1.Range("A1:D" & ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row).Copy pivotWs.Range("A1")
    lastRow = pivotWs.Cells(pivotWs.Rows.Count, "D").End(xlUp).Row + 1
    ws2.Range("A2:D" & ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row).Copy pivotWs.Range("A" & lastRow)
    
    ' 设置透视表数据源
    Set sourceRange = pivotWs.Range("A1:D" & pivotWs.Cells(pivotWs.Rows.Count, "D").End(xlUp).Row)
    
    ' 创建透视缓存与透视表
    Set pivotCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=sourceRange)
    Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=pivotWs.Range("F1"), TableName:="金额对比透视表")
    
    ' 配置透视表字段
    With pivotTable
        .PivotFields("Type").Orientation = xlRowField
        ' 假设D列表头为"金额"，按需修改
        .AddDataField .PivotFields("金额"), "工作簿1总金额", xlSum
        .AddDataField .PivotFields("金额"), "工作簿2总金额", xlSum
        
        ' 添加金额差异计算字段
        .CalculatedFields.Add "金额差异", "='工作簿1总金额'-'工作簿2总金额'"
        .PivotFields("金额差异").Orientation = xlDataField
    End With
End Sub

使用注意事项 #

1. 替换代码中的工作簿路径为你的实际文件路径
2. 确保两个工作簿的表头一致：A列为Type，D列为金额类字段
3. 直接运行CompareWorkbooks宏即可触发完整校验流程
4. 透视表报告会自动生成在当前运行宏的工作簿中

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