如何用VBA对比两工作表指定列并高亮匹配行（忽略正负值）

原代码通过整行内容生成匹配键来查找重复项，无法满足以下需求：

• 当Sheet2的B列与Sheet1的K列内容匹配
• 且Sheet2的F列数值忽略正负后与Sheet1的G列数值匹配时
  将Sheet1中符合条件的整行文本设置为黄色。

修改后的完整代码 #

Sub testhighlightdups()
    Dim rng1 As Range, rng2 As Range, r As Long
    Dim dups As Object, k As String, rngDel As Range, rw As Range
    
    Set rng1 = ThisWorkbook.Worksheets("Sheet1").Range("A1").CurrentRegion
    Set rng2 = ThisWorkbook.Worksheets("Sheet2").Range("A1").CurrentRegion
    
    ' 从Sheet2的指定列生成匹配键字典
    Set dups = RowKeyCount(rng2.Offset(1).Resize(rng2.Rows.Count - 1))
    
    ' 遍历Sheet1数据行，匹配则标记
    For r = 2 To rng1.Rows.Count
        Set rw = rng1.Rows(r)
        k = GetSheet1RowKey(rw)
        If Len(k) > 0 And dups.exists(k) Then
            BuildRange rngDel, rw
            dups(k) = dups(k) - 1
            If dups(k) = 0 Then dups.Remove k
        End If
    Next r
    
    ' 批量设置匹配行字体颜色为黄色
    If Not rngDel Is Nothing Then rngDel.Font.Color = vbYellow
End Sub

Function RowKeyCount(rng As Range) As Object
    Dim rw As Range, k As String, dict As Object
    Set dict = CreateObject("scripting.dictionary")
    For Each rw In rng.Rows
        ' 提取Sheet2的B列和F列（取绝对值）生成键
        Dim colBValue As String, colFAbsValue As String
        colBValue = CStr(rw.Cells(1, "B").Value)
        colFAbsValue = CStr(Abs(rw.Cells(1, "F").Value))
        k = colBValue & "|" & colFAbsValue
        
        If Len(k) > 0 Then dict(k) = dict(k) + 1
    Next rw
    Set RowKeyCount = dict
End Function

Function GetSheet1RowKey(rw As Range) As String
    ' 提取Sheet1的K列和G列（取绝对值）生成匹配键
    Dim colKValue As String, colGAbsValue As String
    colKValue = CStr(rw.Cells(1, "K").Value)
    colGAbsValue = CStr(Abs(rw.Cells(1, "G").Value))
    GetSheet1RowKey = colKValue & "|" & colGAbsValue
End Function

Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

核心修改说明 #

1. 拆分匹配键生成逻辑：针对Sheet1和Sheet2分别处理指定列，替代原整行生成键的逻辑
2. 忽略正负匹配：对数值列（Sheet2的F列、Sheet1的G列）使用Abs()函数取绝对值，确保正负数值能匹配
3. 统一键格式：用CStr()将列值转为字符串，避免数值与文本类型差异导致的匹配失败
4. 保留高效批量处理：继续使用字典计数+合并区域后批量设置格式的逻辑，避免逐行操作的性能损耗

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