[已解决]修改部分代码

mate33

修改部分代码

最佳答案

月排行榜 / 总排行榜

grf1973

2017-4-23 20:50

请看附件。

跳转到最佳答案楼层

lipenghui

Sub tt()
    Dim rng As Range
    ActiveSheet.UsedRange.Cells.Interior.ColorIndex = 0
   
    arr = Range(Selection.Address & ":" & Range("AO10")) '修改内容

    Set rng = Selection(1) '左上位置
    On Error Resume Next     '容错，超过边界
    For i = 2 To UBound(arr)
        x = arr(i, 1): y = arr(i, 2): Z = arr(i, 3)
        rng.Offset(i - 1).Resize(1, 3).Interior.ColorIndex = 6   '对比数，标注黄色
        For j = 4 To UBound(arr, 2) Step 3
            xyz = ""
            xyz = arr(i - 1, j) & arr(i - 1, j + 1) & arr(i - 1, j + 2)
            If InStr(xyz, x) Or InStr(xyz, y) Or InStr(xyz, Z) Then
                rng.Offset(i - 2, j - 1).Resize(1, 3).Interior.ColorIndex = 3       '符合条件的，标注红色
            End If
        Next
    Next
End Sub

lipenghui

文件

grf1973

请看附件。