开篇

做数据的朋友肯定都遇到过这种场景：

月底了，老板让你把这个月上报的数据和上个月原始数据做对比，找出所有修改的地方； 两份报表结构一模一样，就是数据变了，要你核对出哪里不一样； 改了好几版的文件，同事最后又发了一版，你得找出哪里做了调整...

打开两个表，开始一行行瞅，一列列对，眼睛都看花了才找出来十几个差异，还不敢保证漏没漏。半小时过去了，腰也酸了眼也花了，效率低到怀疑人生。

其实这种重复又费眼的工作，完全可以交给Excel自动完成！今天就给大家分享一个我常用的VBA工具，只要选择两个表，一键就能帮你找出所有差异，还自动生成差异清单，标记出不同位置，10万行数据几分钟搞定，比你手工核对快100倍。

先看视屏

解决方案

这个工具的核心思路非常简单：

1. 让你手动输入需要对比的两个工作表（旧表/原始表、新表/修改后表）
2. 自动读取两个表的所有数据，逐单元格对比内容
3. 找到差异后：在两个原表中直接用颜色标记差异单元格，同时自动生成一份「差异结果表」，把所有差异的位置、旧值、新值整理得清清楚楚
4. 支持行数/列数不一致的情况对比，还做了错误值兼容，非常灵活

默认对比单元格显示的内容，如果需要对比单元格里的公式，改一行代码就能实现，非常方便。

代码实现

核心功能说明

✅ 自动识别两个工作表所有单元格差异
✅ 在原表中用黄色高亮标记差异位置
✅ 自动生成差异清单，包含行号、列名、新旧值一目了然
✅ 支持表头配置，兼容有表头/无表头两种情况
✅ 遇到错误值也能正常对比，不会中断运行
✅ 结构不一致提前提示，避免无效对比

📝 完整代码如下：

Option Explicit
' 配置常量（可根据实际需求修改）
Const HEADER_ROW As Integer = 1 ' 表头所在行，无表头则设为0
Const DIFF_COLOR As Long = 65535 ' 差异单元格标记颜色（默认黄色）

Sub 双表差异对比识别()
    ' 变量声明
    Dim wsOld As Worksheet, wsNew As Worksheet, wsDiff As Worksheet
    Dim lMaxRow As Long, lMaxCol As Long ' 两个表的最大行、最大列
    Dim i As Long, j As Long ' 循环计数器
    Dim diffCount As Long ' 差异数量统计
    Dim oldVal, newVal ' 存储单元格值，避免多次读取
    Dim oldSheetName As String, newSheetName As String ' 存储用户输入的工作表名称

    ' 关闭屏幕更新和事件触发，提升运行速度
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    ' 错误处理机制
    On Error GoTo ErrorHandler

    ' --------------------------
    ' 步骤1：准备差异结果工作表
    ' --------------------------
    ' 如果已存在差异表则先删除
    Application.DisplayAlerts = False ' 关闭删除提示
    On Error Resume Next
    ThisWorkbook.Sheets("差异结果").Delete
    On Error GoTo ErrorHandler
    Application.DisplayAlerts = True

    ' 新建差异结果表
    Set wsDiff = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsDiff.Name = "差异结果"
    ' 写入差异表表头
    With wsDiff
        .Cells(1, 1) = "行号"
        .Cells(1, 2) = "列标"
        .Cells(1, 3) = "列名称"
        .Cells(1, 4) = "旧表值"
        .Cells(1, 5) = "新表值"
        ' 设置表头样式
        .Range("A1:E1").Font.Bold = True
        .Range("A1:E1").EntireColumn.AutoFit
    End With
    diffCount = 0 ' 初始化差异计数器

    ' --------------------------
    ' 步骤2：获取用户指定的对比工作表（改为手动输入名称）
    ' --------------------------
    ' 输入第一个工作表名称
    oldSheetName = Application.InputBox(prompt:="请输入【旧版本/原始数据】工作表名称（例如：Sheet1）" & vbCrLf & _
                                        "注意：名称区分大小写，且必须存在于当前工作簿中", _
                                        Title:="输入第一个对比表名称", Type:=2)
    If oldSheetName = "" Then GoTo Cleanup
    On Error Resume Next
    Set wsOld = ThisWorkbook.Worksheets(oldSheetName)
    If wsOld Is Nothing Then
        MsgBox "工作表【" & oldSheetName & "】不存在，请检查后重试", vbExclamation
        GoTo Cleanup
    End If

    ' 输入第二个工作表名称
    newSheetName = Application.InputBox(prompt:="请输入【新版本/上报数据】工作表名称（例如：Sheet2）" & vbCrLf & _
                                        "注意：名称区分大小写，且必须存在于当前工作簿中", _
                                        Title:="输入第二个对比表名称", Type:=2)
    If newSheetName = "" Then GoTo Cleanup
    Set wsNew = ThisWorkbook.Worksheets(newSheetName)
    If wsNew Is Nothing Then
        MsgBox "工作表【" & newSheetName & "】不存在，请检查后重试", vbExclamation
        GoTo Cleanup
    End If
    On Error GoTo ErrorHandler

    ' 校验是否选择了同一个工作表
    If wsOld.Name = wsNew.Name Then
        MsgBox "不能选择同一个工作表进行对比，请重新输入不同的工作表名称", vbExclamation
        GoTo Cleanup
    End If

    ' --------------------------
    ' 步骤3：校验两个表结构是否匹配
    ' --------------------------
    lMaxRow = WorksheetFunction.Max(wsOld.UsedRange.Rows.Count, wsNew.UsedRange.Rows.Count)
    lMaxCol = WorksheetFunction.Max(wsOld.UsedRange.Columns.Count, wsNew.UsedRange.Columns.Count)

    ' 提示用户结构不一致风险
    If wsOld.UsedRange.Rows.Count <> wsNew.UsedRange.Rows.Count Or wsOld.UsedRange.Columns.Count <> wsNew.UsedRange.Columns.Count Then
        If MsgBox("两个表的行数/列数不一致，继续对比可能存在偏差，是否继续？", vbYesNo + vbQuestion) = vbNo Then
            GoTo Cleanup
        End If
    End If

    ' --------------------------
    ' 步骤4：逐单元格对比数据
    ' --------------------------
    ' 从表头下第一行开始对比，无表头则从第1行开始
    For i = IIf(HEADER_ROW > 0, HEADER_ROW + 1, 1) To lMaxRow
        For j = 1 To lMaxCol
            ' 读取两个表对应单元格的值
            oldVal = wsOld.Cells(i, j).Value
            newVal = wsNew.Cells(i, j).Value

            ' 处理错误值特殊情况
            If IsError(oldVal) Or IsError(newVal) Then
                ' 两个都是错误值且错误类型相同则跳过，否则标记差异
                If Not (IsError(oldVal) And IsError(newVal) And CStr(oldVal) = CStr(newVal)) Then
                    GoTo MarkDiff
                End If
            Else
                ' 普通值对比，忽略大小写可将vbBinaryCompare改为vbTextCompare
                If StrComp(CStr(oldVal), CStr(newVal), vbBinaryCompare) <> 0 Then
                    GoTo MarkDiff
                End If
            End If

            ' 无差异则继续下一个单元格
            GoTo NextCell

MarkDiff:
            ' 标记差异单元格
            wsOld.Cells(i, j).Interior.Color = DIFF_COLOR
            wsNew.Cells(i, j).Interior.Color = DIFF_COLOR

            ' 记录差异到结果表
            diffCount = diffCount + 1
            With wsDiff
                .Cells(diffCount + 1, 1) = i ' 行号
                .Cells(diffCount + 1, 2) = ColNoToLetter(j) ' 列标（转成A/B/C样式）
                .Cells(diffCount + 1, 3) = IIf(HEADER_ROW > 0, wsOld.Cells(HEADER_ROW, j).Value, "无表头") ' 列名称
                .Cells(diffCount + 1, 4) = IIf(IsError(oldVal), CStr(oldVal), oldVal) ' 旧值
                .Cells(diffCount + 1, 5) = IIf(IsError(newVal), CStr(newVal), newVal) ' 新值
            End With

NextCell:
        Next j
    Next i

    ' --------------------------
    ' 步骤5：输出对比结果
    ' --------------------------
    wsDiff.Range("A1:E" & diffCount + 1).EntireColumn.AutoFit ' 自动调整列宽
    MsgBox "对比完成，共找到 " & diffCount & " 处差异，详情请查看【差异结果】表", vbInformation

Cleanup:
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    ' 释放对象内存
    Set wsOld = Nothing
    Set wsNew = Nothing
    Set wsDiff = Nothing
    Exit Sub

ErrorHandler:
    ' 错误提示
    MsgBox "运行出错：" & Err.Number & " - " & Err.Description, vbCritical
    ' 出错也恢复Excel设置，避免程序卡死
    GoTo Cleanup
End Sub

'========================================
' 辅助函数：将列号转换为Excel列标（如2→B，27→AA）
'========================================
Function ColNoToLetter(colNo As Long) As String
    Dim arr
    arr = Split(Cells(1, colNo).Address, "$")
    ColNoToLetter = arr(1)
End Function

代码解析

几个可以自己改的配置项，放在代码开头，非常容易修改：

Const HEADER_ROW As Integer = 1 ' 表头所在行，无表头则设为0
Const DIFF_COLOR As Long = 65535' 差异单元格标记颜色（默认黄色）

如果你的表格表头在第3行，直接把1改成3就行，不需要改其他地方。想改标记颜色，改第二行代码数值就可以。

另外默认对比的是单元格显示的值，如果需要对比单元格里的公式，只需要把代码里两处.Value改成.Formula就可以：

oldVal = wsOld.Cells(i, j).Value
newVal = wsNew.Cells(i, j).Value

针对大家容易遇到的错误值（#N/A、#VALUE!这类），代码也做了特殊处理：如果两个单元格都是同样的错误值，会判定为相同，否则判定为差异，不会出现运行报错的情况。

使用步骤

新手朋友按照下面的步骤操作就可以用：

1. 打开你的Excel文件，把两个需要对比的工作表放在同一个工作簿里（如果不在一个文件，先复制到同一个文件里）
2. 按Alt + F11打开VBA编辑器
3. 在左侧窗口右键点击你的工作簿名称，选择「插入」→「模块」
4. 把上面的完整代码复制粘贴到弹出的模块窗口里
5. 关闭VBA编辑器，回到Excel，按Alt + F8调出宏窗口，选择宏点击「执行」（直接在VBA编辑器运行也可以）
6. 按照提示依次输入两个需要对比的工作表：先选第一个（旧版本/原始数据），再选第二个（新版本/修改后数据），点击确定就可以
7. 等待程序运行完成，会弹出提示告诉你一共找到多少差异，你可以在自动生成的「差异结果」表里看到所有差异明细，也可以回到原表查看黄色高亮的差异单元格

注意事项

⚠️ 对比前建议先保存文件，因为程序会直接在原表标记背景色，如果需要还原可以撤销保存

⚠️ 如果两个表行数/列数差异很大，程序会提前提示你，确认后再继续对比就好

⚠️ 默认区分英文大小写，如果需要忽略大小写，把代码里vbBinaryCompare改成vbTextCompare即可

⚠️ 数据量超过1万行的时候，运行需要几秒钟，属于正常情况，不要多次点击，耐心等待即可

⚠️新表和旧表每行的数据要一一对应于，数据记录要一致，否则会认为都是变化的单元格

结语

核对差异真的是数据工作中非常高频的操作，原来半小时的活，现在几十秒搞定，剩下的时间喝杯咖啡不好吗？

这个工具我自己用了大半年，不管是月度数据核对还是版本对比都非常好用，今天分享给大家。

如果你经常需要做这类核对，一定要试试这个方法，真的能省超多时间！

🔔 关注公众号「宏蜘蛛」，获取更多实用VBA自动化工具，帮你把重复工作交给电脑做！