[已解决]求当S2=中，K3=中时，两者相同时，单元格填充颜色

ruhong18

用函数或者VBA代码，将S列与K列上下相隔一行，如当S2=中，K3=中时，两者相同时，单元格填充颜色，当S5=中，K6=中时，当S8=下，K9=下时，两者相同时，单元格填充颜色，依此类推….

最佳答案

月排行榜 / 总排行榜

我行我速2008

2022-8-16 17:03

Sub tt()
    Dim r%, ar, i, k
    ar = Range("K1:S" & Cells(Rows.Count, 11).End(xlUp).Row)
    Columns("k:S").Interior.ColorIndex = xlNone
    For r = 2 To UBound(ar)
        If ar(r, 1) <> "" Then
            For k = 1 To Len(ar(r, 1))
                For i = 1 To Len(ar(r - 1, 9))
                    If Mid(ar(r, 1), k, 1) = Mid(ar(r - 1, 9), i, 1) Then Union(Cells(r, 11), Cells(r - 1, 19)).Interior.ColorIndex = 45
                Next i
            Next k
        End If
    Next r
End Sub

跳转到最佳答案楼层

哥儿-

Sub test()
    Dim arr, brr, i%
    arr = Range("s2").CurrentRegion
    brr = Range("k2").CurrentRegion
    For i = 1 To UBound(arr) - 1
        If arr(i, 1) = brr(i + 1, 1) Then
            Range("s" & i + 1).Interior.Color = 10079487
            Range("k" & i + 2).Interior.Color = 10079487
        End If
    Next i
End Sub

哥儿-

两次条件格式：从s2开始选择范围，公式：=$S2=$K3
                    ：从k2开始选择范围，公式：=$K2=$S1

我行我速2008

Sub tt()
    Dim r%, ar
    ar = Range("K1:S" & Cells(Rows.Count, 11).End(xlUp).Row)
    Columns("k:S").Interior.ColorIndex = xlNone
    For r = 2 To UBound(ar)
        If ar(r, 1) <> "" And ar(r, 1) = ar(r - 1, 9) Then
            Union(Cells(r, 11), Cells(r - 1, 19)).Interior.ColorIndex = 45
        End If
    Next r
End Sub

ruhong18

我行我速2008 发表于 2022-8-16 12:23
Sub tt()
    Dim r%, ar
    ar = Range("K1:S" & Cells(Rows.Count, 11).End(xlUp).Row)

感谢帮助，代码测试正确，如果S列与K列上下相隔一行，如当S2包含K3任意字符时，单元格填充颜色，依此类推….的话，代码可以怎么修改吗？

我行我速2008

Sub tt()
    Dim r%, ar, i, k
    ar = Range("K1:S" & Cells(Rows.Count, 11).End(xlUp).Row)
    Columns("k:S").Interior.ColorIndex = xlNone
    For r = 2 To UBound(ar)
        If ar(r, 1) <> "" Then
            For k = 1 To Len(ar(r, 1))
                For i = 1 To Len(ar(r - 1, 9))
                    If Mid(ar(r, 1), k, 1) = Mid(ar(r - 1, 9), i, 1) Then Union(Cells(r, 11), Cells(r - 1, 19)).Interior.ColorIndex = 45
                Next i
            Next k
        End If
    Next r
End Sub

ruhong18

哥儿- 发表于 2022-8-16 12:10
Sub test()
    Dim arr, brr, i%
    arr = Range("s2").CurrentRegion

感谢帮助~

ruhong18

我行我速2008 发表于 2022-8-16 12:23
Sub tt()
    Dim r%, ar
    ar = Range("K1:S" & Cells(Rows.Count, 11).End(xlUp).Row)

感谢帮助~

我行我速2008

认为行就选为最佳答案