VBA对比多组列数据：高亮差异并复制至复核列问题求助

我明白你卡了好几个小时的痛点——本来想高亮不匹配的错误项，结果代码反而把匹配的标了，还不知道怎么把这些错误项导到复核列里。结合你提到的类似思路，我给你调整出一套能解决问题的方案，一步步讲清楚怎么改：

1. 修正高亮逻辑（从“高亮匹配项”改为“高亮不匹配项”） #

你的代码大概率是用了Not IsError(Application.Match(...))的判断逻辑，这会把在对应列存在的单元格（匹配项）选中高亮。我们需要把判断条件反过来：当IsError(Application.Match(...))时，说明当前单元格的值在对应列找不到，也就是需要高亮的错误项。

2. 添加错误项复制到复核列的逻辑 #

对于每一个不匹配的单元格，我们要把它的值复制到对应列右侧第2列的同一行（比如A列的错误项复制到C列，D列的复制到F列）。可以通过列号偏移实现：源列号+2就是复核列号（A是1，1+2=3即C列；D是4，4+2=6即F列）。

完整修正后的VBA代码 #

Sub HighlightAndCopyMismatches()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim currentRow As Long
    Dim columnGroups As Variant
    Dim i As Integer
    Dim sourceCol As Integer, targetCol As Integer, reviewCol As Integer
    Dim cellValue As Variant
    Dim matchResult As Variant
    
    ' 设置目标工作表，可替换为具体表名如Sheet1
    Set ws = ActiveSheet
    
    ' 定义需要对比的列组：每一组是(源列, 目标列)，比如A(1)和B(2)、D(4)和E(5)
    columnGroups = Array(Array(1, 2), Array(4, 5))
    
    ' 遍历每一组列
    For i = LBound(columnGroups) To UBound(columnGroups)
        sourceCol = columnGroups(i)(0) ' 源列：A、D等
        targetCol = columnGroups(i)(1) ' 目标列：B、E等
        reviewCol = sourceCol + 2 ' 复核列：C、F等（源列右侧第2列）
        
        ' 找到当前组源列的最后一行（从第3行开始）
        lastRow = ws.Cells(ws.Rows.Count, sourceCol).End(xlUp).Row
        If lastRow < 3 Then lastRow = 3 ' 确保至少从第3行开始遍历
        
        ' 从第3行开始逐行检查
        For currentRow = 3 To lastRow
            cellValue = ws.Cells(currentRow, sourceCol).Value
            
            ' 跳过空单元格，避免无效判断
            If cellValue <> "" Then
                ' 检查源列值是否在目标列中存在
                matchResult = Application.Match(cellValue, ws.Columns(targetCol), 0)
                
                ' 若不存在（匹配返回错误），则高亮并复制到复核列
                If IsError(matchResult) Then
                    ' 高亮错误项：这里用黄色填充，可自行修改颜色
                    ws.Cells(currentRow, sourceCol).Interior.Color = RGB(255, 255, 0)
                    ' 复制错误值到复核列
                    ws.Cells(currentRow, reviewCol).Value = cellValue
                Else
                    ' 若匹配，清除高亮并清空复核列对应行内容
                    ws.Cells(currentRow, sourceCol).Interior.ColorIndex = xlColorIndexNone
                    ws.Cells(currentRow, reviewCol).ClearContents
                End If
            Else
                ' 空单元格处理：清除高亮和复核列内容
                ws.Cells(currentRow, sourceCol).Interior.ColorIndex = xlColorIndexNone
                ws.Cells(currentRow, reviewCol).ClearContents
            End If
        Next currentRow
    Next i
    
    MsgBox "处理完成！", vbInformation
End Sub

代码关键说明 #

• 灵活的列组配置：用columnGroups数组存放所有需要对比的列对，以后要新增列组（比如G和H，复核列是I），直接在数组里加Array(7,8)即可。
• 反向匹配判断：用IsError(matchResult)精准定位“未在对应列出现”的错误项，彻底修正高亮逻辑反转的问题。
• 自动对应复核列：通过reviewCol = sourceCol + 2自动计算复核列位置，不用手动指定每一列的编号。
• 残留内容清理：处理匹配项和空单元格时，会清除之前的高亮和复核列内容，避免旧数据干扰。

使用小提示 #

1. 若要修改高亮颜色，把RGB(255,255,0)换成你需要的RGB值，或者用Excel内置颜色常量（比如xlColorIndex3是红色）。
2. 如果目标工作表不是当前激活的表，把Set ws = ActiveSheet改成Set ws = ThisWorkbook.Sheets("你的工作表名称")。
3. 运行前建议备份数据，避免意外情况。

内容的提问来源于stack exchange，提问作者Martim On Fire