求助：VBA实现单元格值匹配同步颜色及同行单元格着色

修改后的基础版本代码 #

Sub test()
    Dim acel As Range
    Dim hcel As Range

    With Worksheets("Sheet1")
        For Each acel In .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
            For Each hcel In .Range("H3", .Cells(.Rows.Count, "H").End(xlUp))
                If hcel.Value = acel.Value Then
                    hcel.Interior.Color = acel.Interior.Color
                    ' 同步同行I列颜色，I是H的右侧第1列，用Offset(0,1)定位
                    hcel.Offset(0, 1).Interior.Color = hcel.Interior.Color
                End If
            Next hcel
        Next acel
    End With
End Sub

关键改动说明 #

在匹配到A列与H列的相同值、完成H列颜色同步后，直接通过hcel.Offset(0,1)定位到同行的I列单元格，将其颜色设置为H列单元格的颜色即可。你之前尝试失败大概率是因为额外添加了独立循环，导致定位错误或重复覆盖。

效率优化版本（推荐） #

原代码的双重循环在数据量较大时运行效率极低，改用Range.Find方法查找匹配值，能大幅提升速度：

Sub test_optimized()
    Dim acel As Range
    Dim findResult As Range
    Dim firstFindAddress As String
    
    With Worksheets("Sheet1")
        ' 遍历A列所有目标单元格
        For Each acel In .Range("A3", .Cells(.Rows.Count, "A").End(xlUp))
            ' 在H列查找匹配值
            Set findResult = .Range("H:H").Find(What:=acel.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not findResult Is Nothing Then
                firstFindAddress = findResult.Address
                Do
                    ' 同步H列颜色
                    findResult.Interior.Color = acel.Interior.Color
                    ' 同步同行I列颜色
                    findResult.Offset(0, 1).Interior.Color = findResult.Interior.Color
                    ' 查找下一个匹配值
                    Set findResult = .Range("H:H").FindNext(findResult)
                Loop While Not findResult Is Nothing And findResult.Address <> firstFindAddress
            End If
        Next acel
    End With
End Sub

优化点说明 #

• 用Find+FindNext替代双重循环，避免逐单元格比对，数据量越大效率提升越明显
• LookAt:=xlWhole确保完全匹配单元格内容（如需模糊匹配可改为xlPart）
• 记录第一个匹配地址，避免无限循环

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