VBA比对两Excel工作表：将差异值按对应表头写入新表求助

现有代码存在的问题 #

• 差异值固定写入输出表前两列，无法匹配原表表头归属
• 未清空输出表历史数据，多次运行会残留旧结果
• 行列计数变量使用Double类型，大行数场景下存在计算精度风险
• 仅按照第一个工作表的已用区域做比对，两表行列数不一致时会漏判差异

核心调整逻辑 #

• 运行比对前先清空输出表，将原表表头完整复制到输出表，保证列结构和原表完全对齐
• 差异值写入时严格匹配原单元格所在列，确保值归属于对应表头列下
• 比对范围取两表已用区域的最大行、最大列，覆盖所有单元格
• 输出表第一列标注差异的来源位置（原行号、所属工作表），方便溯源
• 所有行列计数变量统一改为Long类型，兼容大行数表格
• 完成比对后自动适配输出表列宽，提升可读性

优化后完整代码 #

Option Explicit

Sub Compare_Two_Excel_Sheets_Highlight_Differences()
    'Define Fields
    Dim iRow As Long, iCol As Long, oRow As Long
    Dim iRow_Max As Long, iCol_Max As Long
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim shOut As Worksheet
    
    'Sheets to be compared
    Set sh1 = ThisWorkbook.Sheets(1)
    Set sh2 = ThisWorkbook.Sheets(2)
    Set shOut = ThisWorkbook.Sheets(3)
    
    '清空输出表历史数据
    shOut.Cells.Clear
    
    '取两表最大行列作为比对范围，避免漏判
    iRow_Max = Application.Max(sh1.UsedRange.Rows.Count, sh2.UsedRange.Rows.Count)
    iCol_Max = Application.Max(sh1.UsedRange.Columns.Count, sh2.UsedRange.Columns.Count)
    
    '写入输出表表头，结构和原表对齐
    shOut.Cells(1, 1) = "差异位置"
    For iCol = 1 To iCol_Max
        shOut.Cells(1, iCol + 1) = sh1.Cells(1, iCol) '默认原表第一行为表头，可根据实际情况修改行号
    Next iCol
    oRow = 1 '表头占第1行，数据从第2行开始写入
    
    '清除两表原有高亮，逐格比对
    For iRow = 1 To iRow_Max
        For iCol = 1 To iCol_Max
            sh1.Cells(iRow, iCol).Interior.Color = xlNone
            sh2.Cells(iRow, iCol).Interior.Color = xlNone
            
            '比对值不一致时高亮+写入输出表
            If CStr(sh1.Cells(iRow, iCol).Value) <> CStr(sh2.Cells(iRow, iCol).Value) Then
                '高亮两表差异单元格
                sh1.Cells(iRow, iCol).Interior.Color = vbYellow
                sh2.Cells(iRow, iCol).Interior.Color = vbYellow
                
                '写入Sheet1的差异值，匹配对应列
                oRow = oRow + 1
                shOut.Cells(oRow, 1) = "第" & iRow & "行_Sheet1"
                shOut.Cells(oRow, iCol + 1) = sh1.Cells(iRow, iCol).Value
                
                '写入Sheet2的差异值，匹配对应列
                oRow = oRow + 1
                shOut.Cells(oRow, 1) = "第" & iRow & "行_Sheet2"
                shOut.Cells(oRow, iCol + 1) = sh2.Cells(iRow, iCol).Value
            End If
        Next iCol
    Next iRow
    
    '自动调整输出表列宽
    shOut.Columns.AutoFit
    
    'Process Completed
    MsgBox "Task Completed"
    
End Sub

使用说明 #

• 代码默认工作簿第1、2个表为待比对表，第3个表为输出表，可根据实际工作表顺序修改Set shxxx对应的索引值
• 代码默认原表第一行为表头，如果表头在其他行，修改表头写入部分、比对起始行号的参数即可
• 比对时加了CStr转换，可避免数值/文本格式相同但值相等的误判，不需要可以直接删除
• 如果需要同一行展示两表同位置的差异，可自行调整输出表结构，将同一iRow、iCol对应的两个值写在同一行的对应列即可

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