Excel VBA列对比宏异常：仅首个客户对比正常，其余客户失效

需要对比Excel中G列与C列的条目，C列数据分属多个客户（如Client A_BB、A_BG、A_JJ），用宏高亮两列差异，但当前宏仅对第一个客户有效，其余客户的G列高亮结果错误。

原VBA代码 #

Sub compare_cols()

    Dim myRng As Range
    Dim lastCell As Long

    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count

    'Debug.Print "Last Row is " & lastRow

    Dim c As Range
    Dim d As Range

    Application.ScreenUpdating = False

    For Each c In Worksheets("Sheet1").Range("C1:C" & lastRow).Cells
        For Each d In Worksheets("Sheet1").Range("G1:G" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
                End If
        Next
    Next

    For Each c In Worksheets("Sheet1").Range("G1:G" & lastRow).Cells
        For Each d In Worksheets("Sheet1").Range("C1:C" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next

Application.ScreenUpdating = True

End Sub

问题分析 #

1. 无客户分组逻辑：原代码遍历整个C列和G列，跨客户的条目会互相匹配，导致非目标客户的匹配干扰结果，比如A_BG的G列条目可能匹配到A_BB的C列条目，错误取消高亮。
2. InStr匹配逻辑错误：使用InStr判断的是包含关系而非完全匹配，比如C列的"abc"会匹配G列的"abcd"，不符合常规条目对比需求。
3. 最后行获取不可靠：UsedRange.Rows.Count可能因工作表残留格式或空单元格返回错误行数。
4. 双重循环效率低下：嵌套遍历两列所有单元格，数据量大时运行极慢。

修正后的VBA代码 #

Sub CompareColsByClient()
    Dim ws As Worksheet
    Dim lastRowC As Long, lastRowG As Long
    Dim cCell As Range, gCell As Range
    Dim client As String
    Dim clientDict As Object
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Application.ScreenUpdating = False
    
    ' 清除原有高亮
    ws.Range("C:C, G:G").Interior.ColorIndex = xlColorIndexNone
    
    ' 可靠获取各列最后一行（跳过空行）
    lastRowC = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    lastRowG = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    
    ' 创建字典存储每个客户的C列条目集合
    Set clientDict = CreateObject("Scripting.Dictionary")
    For Each cCell In ws.Range("C2:C" & lastRowC) ' 假设第1行是表头
        ' 从相邻列获取客户标识（此处假设客户在B列，需根据实际表格调整列号）
        client = ws.Cells(cCell.Row, "B").Value
        If Not clientDict.Exists(client) Then
            Set clientDict(client) = New Collection
        End If
        ' 添加条目到对应客户集合（避免重复条目报错）
        On Error Resume Next
        clientDict(client).Add cCell.Value, Key:=CStr(cCell.Value)
        On Error GoTo 0
    Next cCell
    
    ' 处理G列：高亮同一客户下无匹配的条目
    For Each gCell In ws.Range("G2:G" & lastRowG)
        client = ws.Cells(gCell.Row, "F").Value ' 假设G列对应客户在F列，需调整
        If clientDict.Exists(client) Then
            ' 检查当前G列条目是否在对应客户的C列集合中
            On Error Resume Next
            clientDict(client).Item(gCell.Value)
            If Err.Number <> 0 Then
                gCell.Interior.Color = vbRed
            End If
            On Error GoTo 0
        Else
            ' 找不到对应客户组的条目直接高亮
            gCell.Interior.Color = vbRed
        End If
    Next gCell
    
    ' 处理C列：高亮同一客户下无匹配的条目
    For Each cCell In ws.Range("C2:C" & lastRowC)
        client = ws.Cells(cCell.Row, "B").Value
        Dim isMatched As Boolean
        isMatched = False
        ' 遍历同一客户的G列条目
        For Each gCell In ws.Range("G2:G" & lastRowG)
            If ws.Cells(gCell.Row, "F").Value = client And gCell.Value = cCell.Value Then
                isMatched = True
                Exit For
            End If
        Next gCell
        If Not isMatched Then
            cCell.Interior.Color = vbRed
        End If
    Next cCell
    
    Application.ScreenUpdating = True
End Sub

修正说明 #

• 客户分组匹配：通过字典按客户分类存储C列条目，确保仅在同一客户范围内对比，避免跨客户干扰。
• 完全匹配逻辑：改为判断条目完全一致（如需包含匹配，可替换为InStr逻辑，但需保留客户分组）。
• 优化最后行获取：使用Cells(Rows.Count, Col).End(xlUp).Row精准获取数据最后一行。
• 效率提升：利用字典快速查找匹配，减少嵌套循环次数，同时避免重复条目报错。

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