夜雨聆风
开篇
做数据的朋友肯定都遇到过这种场景：
月底了，老板让你把这个月上报的数据和上个月原始数据做对比，找出所有修改的地方； 两份报表结构一模一样，就是数据变了，要你核对出哪里不一样； 改了好几版的文件，同事最后又发了一版，你得找出哪里做了调整...
打开两个表，开始一行行瞅，一列列对，眼睛都看花了才找出来十几个差异，还不敢保证漏没漏。半小时过去了，腰也酸了眼也花了，效率低到怀疑人生。
其实这种重复又费眼的工作，完全可以交给Excel自动完成！今天就给大家分享一个我常用的VBA工具，只要选择两个表，一键就能帮你找出所有差异，还自动生成差异清单，标记出不同位置，10万行数据几分钟搞定，比你手工核对快100倍。
先看视屏
已关注
关注
重播 分享 赞
解决方案
这个工具的核心思路非常简单：
让你手动输入需要对比的两个工作表（旧表/原始表、新表/修改后表） 自动读取两个表的所有数据，逐单元格对比内容 找到差异后：在两个原表中直接用颜色标记差异单元格，同时自动生成一份「差异结果表」，把所有差异的位置、旧值、新值整理得清清楚楚 支持行数/列数不一致的情况对比，还做了错误值兼容，非常灵活
默认对比单元格显示的内容，如果需要对比单元格里的公式，改一行代码就能实现，非常方便。
代码实现
核心功能说明
✅ 自动识别两个工作表所有单元格差异
✅ 在原表中用黄色高亮标记差异位置
✅ 自动生成差异清单，包含行号、列名、新旧值一目了然
✅ 支持表头配置，兼容有表头/无表头两种情况
✅ 遇到错误值也能正常对比，不会中断运行
✅ 结构不一致提前提示，避免无效对比
📝 完整代码如下：
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!这类），代码也做了特殊处理：如果两个单元格都是同样的错误值，会判定为相同，否则判定为差异，不会出现运行报错的情况。
使用步骤
新手朋友按照下面的步骤操作就可以用：
打开你的Excel文件，把两个需要对比的工作表放在同一个工作簿里（如果不在一个文件，先复制到同一个文件里） 按 Alt + F11打开VBA编辑器在左侧窗口右键点击你的工作簿名称，选择「插入」→「模块」 把上面的完整代码复制粘贴到弹出的模块窗口里 关闭VBA编辑器，回到Excel，按 Alt + F8调出宏窗口，选择宏点击「执行」（直接在VBA编辑器运行也可以）按照提示依次输入两个需要对比的工作表：先选第一个（旧版本/原始数据），再选第二个（新版本/修改后数据），点击确定就可以 等待程序运行完成，会弹出提示告诉你一共找到多少差异，你可以在自动生成的「差异结果」表里看到所有差异明细，也可以回到原表查看黄色高亮的差异单元格
注意事项
⚠️ 对比前建议先保存文件，因为程序会直接在原表标记背景色，如果需要还原可以撤销保存
⚠️ 如果两个表行数/列数差异很大，程序会提前提示你，确认后再继续对比就好
⚠️ 默认区分英文大小写，如果需要忽略大小写，把代码里vbBinaryCompare改成vbTextCompare即可
⚠️ 数据量超过1万行的时候，运行需要几秒钟，属于正常情况，不要多次点击，耐心等待即可
⚠️新表和旧表每行的数据要一一对应于，数据记录要一致，否则会认为都是变化的单元格
结语
核对差异真的是数据工作中非常高频的操作，原来半小时的活，现在几十秒搞定，剩下的时间喝杯咖啡不好吗？
这个工具我自己用了大半年，不管是月度数据核对还是版本对比都非常好用，今天分享给大家。
如果你经常需要做这类核对，一定要试试这个方法，真的能省超多时间！
🔔 关注公众号「宏蜘蛛」，获取更多实用VBA自动化工具，帮你把重复工作交给电脑做！
点击阅读原文获取本篇代码!