使用VBA进行跨工作表列值比对并高亮匹配值的问题求助

原代码存在的问题 #

• 写法错误：ActiveCell = Sheets("Last Week").Range("A2").Activate 这行将Activate方法返回的布尔值赋值给了单元格，直接导致第一列出现True值，正确写法应该直接读取单元格值，无需额外激活操作。
• 变量拼写错误：定义了变量County但实际循环使用的是Count，循环上限取值错误，无法遍历全部行。
• 循环逻辑错误：For循环本身会自动对计数器i递加，代码中额外加了i = i +1，会导致每次跳行，漏检一半数据。
• 比对值未更新：FindString仅在循环外赋值一次，循环过程中没有更新为当前行的单元格值，永远只会比对第一个值，因此只能匹配到一个结果。
• 缺少匹配项高亮逻辑：原代码仅会高亮上周表的匹配单元格，不会对当前周表的匹配项做标记。

修正后的VBA代码 #

Sub 两列字符串比对高亮()
    Dim lastWeekSht As Worksheet, curWeekSht As Worksheet
    Dim lastRow As Long, i As Long
    Dim FindString As String
    Dim Rng As Range
    
    ' 绑定工作表，避免后续重复写工作表名
    Set lastWeekSht = ThisWorkbook.Sheets("Last Week")
    Set curWeekSht = ThisWorkbook.Sheets("Current Week")
    
    ' 获取上周表A列最后一行有数据的行号，避免遍历空行
    lastRow = lastWeekSht.Cells(lastWeekSht.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历上周表A列从第2行开始的所有数据
    For i = 2 To lastRow
        FindString = Trim(lastWeekSht.Cells(i, "A").Value)
        If FindString <> "" Then
            ' 在当前周表A列全匹配查找
            Set Rng = curWeekSht.Range("A:A").Find( _
                What:=FindString, _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                MatchCase:=True _
            )
            
            ' 匹配到的话，两边对应单元格都标蓝
            If Not Rng Is Nothing Then
                lastWeekSht.Cells(i, "A").Font.Color = vbBlue
                Rng.Font.Color = vbBlue
            End If
        End If
    Next i
End Sub

使用说明 #

• 代码默认比对Last Week和Current Week两个表的A列数据，匹配成功后两边对应单元格字体都会标蓝，不需要的可以自行删除对应高亮行。
• 查找参数默认开启大小写匹配、全单元格匹配，如果不需要大小写区分，把MatchCase:=True改成MatchCase:=False即可。
• 不需要选中单元格/激活工作表操作，直接运行宏即可完成全部比对。

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