VBA宏问题：无法按指定规则正确高亮重复行及特定行

需求规则 #

• 规则1：当FirstName、LastName和UniqueID三者同时重复出现多次时，高亮对应行；
• 规则2：当**FirstName、LastName重复出现多次，且该行UniqueID包含"STATEWIDE"**时，高亮对应行。

原代码问题分析 #

原代码存在以下关键问题，导致无法正确匹配规则：

1. 使用三个独立字典分别存储FirstName、LastName、UniqueID，逻辑错误——只要三个值各自出现过就触发高亮，而非三者组合重复；
2. 未实现规则2的判断逻辑；
3. Application.Match在多列范围中默认仅查找第一列，无法正确匹配三者组合的行。

原代码 #

Sub HighlightDuplicateRows()
    Dim ws As Worksheet
    Set ws = ActiveSheet ' Change this to the appropriate worksheet
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Change "A" to the column where the data starts
    
    Dim firstNames As Object
    Set firstNames = CreateObject("Scripting.Dictionary")
    
    Dim lastNames As Object
    Set lastNames = CreateObject("Scripting.Dictionary")
    
    Dim uniqueIDs As Object
    Set uniqueIDs = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 2 To lastRow ' Assuming headers are in row 1
        Dim firstName As String
        firstName = ws.Cells(i, "A").Value ' Change "A" to the appropriate column for first name
        
        Dim lastName As String
        lastName = ws.Cells(i, "B").Value ' Change "B" to the appropriate column for last name
        
        Dim uniqueID As String
        uniqueID = ws.Cells(i, "C").Value ' Change "C" to the appropriate column for unique ID
        
        If firstNames.Exists(firstName) And lastNames.Exists(lastName) And uniqueIDs.Exists(uniqueID) Then
            ' Highlight the original row
            Dim origRow As Variant
            origRow = Application.Match(firstName & lastName & uniqueID, _
                ws.Range("A2:C" & i - 1), 0)
            If IsNumeric(origRow) Then
                ws.Rows(origRow).Interior.Color = RGB(255, 255, 0) ' Highlight the row yellow
            End If
            
            ' Highlight the current row
            ws.Rows(i).Interior.Color = RGB(255, 255, 0) ' Highlight the row yellow
        Else
            firstNames(firstName) = True
            lastNames(lastName) = True
            uniqueIDs(uniqueID) = True
        End If
    Next i
End Sub

修正后的代码 #

Sub HighlightDuplicateRows_Fixed()
    Dim ws As Worksheet
    Set ws = ActiveSheet ' 可修改为指定工作表，如ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then Exit Sub ' 无数据时直接退出
    
    ' 字典1：存储FirstName+LastName+UniqueID的组合，值为该组合出现的次数
    Dim dictFullCombo As Object
    Set dictFullCombo = CreateObject("Scripting.Dictionary")
    ' 字典2：存储FirstName+LastName的组合，值为数组(出现次数, 是否包含STATEWIDE)
    Dim dictNameCombo As Object
    Set dictNameCombo = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    Dim firstName As String, lastName As String, uniqueID As String
    Dim fullKey As String, nameKey As String
    
    ' 第一次遍历：统计所有组合的出现情况
    For i = 2 To lastRow
        firstName = Trim(ws.Cells(i, "A").Value)
        lastName = Trim(ws.Cells(i, "B").Value)
        uniqueID = Trim(ws.Cells(i, "C").Value)
        
        fullKey = firstName & "|" & lastName & "|" & uniqueID
        nameKey = firstName & "|" & lastName
        
        ' 更新全组合字典
        If dictFullCombo.Exists(fullKey) Then
            dictFullCombo(fullKey) = dictFullCombo(fullKey) + 1
        Else
            dictFullCombo(fullKey) = 1
        End If
        
        ' 更新姓名组合字典
        If dictNameCombo.Exists(nameKey) Then
            dictNameCombo(nameKey)(0) = dictNameCombo(nameKey)(0) + 1
            ' 如果当前行包含STATEWIDE，标记该组合为符合规则2条件
            If InStr(1, uniqueID, "STATEWIDE", vbTextCompare) > 0 Then
                dictNameCombo(nameKey)(1) = True
            End If
        Else
            ' 初始值：出现次数1，是否包含STATEWIDE（当前行是否满足）
            dictNameCombo(nameKey) = Array(1, InStr(1, uniqueID, "STATEWIDE", vbTextCompare) > 0)
        End If
    Next i
    
    ' 清除原有高亮
    ws.Rows("2:" & lastRow).Interior.ColorIndex = xlColorIndexNone
    
    ' 第二次遍历：根据规则高亮行
    For i = 2 To lastRow
        firstName = Trim(ws.Cells(i, "A").Value)
        lastName = Trim(ws.Cells(i, "B").Value)
        uniqueID = Trim(ws.Cells(i, "C").Value)
        
        fullKey = firstName & "|" & lastName & "|" & uniqueID
        nameKey = firstName & "|" & lastName
        
        Dim shouldHighlight As Boolean
        shouldHighlight = False
        
        ' 检查规则1：全组合重复
        If dictFullCombo(fullKey) > 1 Then
            shouldHighlight = True
        End If
        
        ' 检查规则2：姓名组合重复，且当前行UniqueID包含STATEWIDE
        If Not shouldHighlight Then
            If dictNameCombo(nameKey)(0) > 1 And InStr(1, uniqueID, "STATEWIDE", vbTextCompare) > 0 Then
                shouldHighlight = True
            End If
        End If
        
        ' 高亮行
        If shouldHighlight Then
            ws.Rows(i).Interior.Color = RGB(255, 255, 0) ' 黄色高亮
        End If
    Next i
    
    ' 释放对象
    Set dictFullCombo = Nothing
    Set dictNameCombo = Nothing
    Set ws = Nothing
End Sub

修正说明 #

1. 组合键设计：使用|作为分隔符拼接字段，避免不同字段内容拼接后产生歧义（如FirstName="AB"、LastName="C" 和 FirstName="A"、LastName="BC"的组合不会混淆）；
2. 两次遍历逻辑：第一次统计所有组合的出现次数和规则2的标记，第二次统一判断高亮，避免单次遍历中遗漏之前的行；
3. 规则2处理：在姓名组合字典中记录该组合是否存在含"STATEWIDE"的行，同时判断当前行是否符合条件；
4. 清除原有高亮：先清除之前的高亮，避免残留错误格式；
5. 容错处理：处理无数据的情况，避免运行错误。

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