Excel VBA对比两列高亮新列新增项 解决类型不匹配错误求助

• 引用逻辑错误：原代码中CountIf的检索范围设为新列本身，完全不符合「新列和上一列对比」的需求
• 对象未绑定工作表：所有Range、Cells对象未显式指定所属工作表，活动工作表非Data表时会直接报错
• 错误值未兼容：单元格存在#N/A、#VALUE!等错误值时，WorksheetFunction.CountIf会直接触发类型不匹配报错
• 列参数传递错误：Worksheets("Data").Columns(LastColumn)返回整列对象，不是列号数值，传入Cells的列参数位置会直接报错

Sub 对比新列并高亮唯一值()
    Dim wsData As Worksheet, wsSummary As Worksheet
    Dim lastCol As Long, lastRowNew As Long, lastRowOld As Long
    Dim rngCell As Range, compareRng As Range
    Dim existDict As Object ' 用字典实现快速匹配+去重
    
    ' 初始化工作表
    Set wsData = ThisWorkbook.Worksheets("Data")
    On Error Resume Next
    Set wsSummary = ThisWorkbook.Worksheets("唯一值汇总")
    If Err.Number <> 0 Then
        Set wsSummary = ThisWorkbook.Worksheets.Add(after:=wsData)
        wsSummary.Name = "唯一值汇总"
    End If
    On Error GoTo 0
    
    ' 获取列信息：最后一列是新导入列，前一列是对比列
    lastCol = wsData.Cells(1, wsData.Columns.Count).End(xlToLeft).Column
    If lastCol < 2 Then
        MsgBox "不存在可对比的上一列数据", vbExclamation
        Exit Sub
    End If
    
    ' 获取两列的有效数据行范围
    lastRowNew = wsData.Cells(wsData.Rows.Count, lastCol).End(xlUp).Row
    lastRowOld = wsData.Cells(wsData.Rows.Count, lastCol - 1).End(xlUp).Row
    Set compareRng = wsData.Range(wsData.Cells(2, lastCol - 1), wsData.Cells(lastRowOld, lastCol - 1))
    
    ' 初始化字典存已写入汇总表的数值，避免重复
    Set existDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历新列数据（从第2行开始，默认第1行是表头）
    For Each rngCell In wsData.Range(wsData.Cells(2, lastCol), wsData.Cells(lastRowNew, lastCol))
        ' 跳过错误值单元格，可根据需求修改为直接标记
        If Not IsError(rngCell.Value) Then
            ' 在上一列中查找是否存在匹配
            If WorksheetFunction.CountIf(compareRng, rngCell.Value) = 0 Then
                ' 高亮不匹配单元格，这里用黄色，可自行修改RGB值
                rngCell.Interior.Color = RGB(255, 255, 0)
                ' 写入汇总表，自动去重
                If Not existDict.exists(rngCell.Value) Then
                    existDict(rngCell.Value) = True
                    wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Offset(1, 0) = rngCell.Value
                End If
            End If
        End If
    Next
    
    ' 释放对象
    Set rngCell = Nothing
    Set compareRng = Nothing
    Set existDict = Nothing
    Set wsData = Nothing
    Set wsSummary = Nothing
End Sub

• 自动识别Data表的最新导入列，无需手动修改列号参数，适配每日新增列的场景
• 自动兼容错误值，不会触发类型不匹配报错
• 无匹配的单元格自动高亮，颜色可自行修改代码中的RGB参数
• 所有无匹配值自动写入「唯一值汇总」工作表，自动去重避免重复写入
• 无需提前创建汇总表，代码运行时会自动创建

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