EXCEL VBA填充单元格颜色

发布网友发布时间：2022-04-24 16:50

共1个回答

热心网友时间：2023-10-23 19:14

Sub s()
    c = Array(33, 14, 47, 6, 7, 12)
    n = Cells(Rows.Count, 11).End(3).Row
    k = 0
    Do While n > 1 And k < 20
        cc = 0
        For i = 11 To 52 Step 14
            f1 = False
            f2 = False
            For j = 0 To 6
                If Cells(n, i + j) = Cells(n - 1, i + j) Then f1 = True: Exit For
            Next
            For j = 7 To 13
                If Cells(n, i + j) = Cells(n - 1, i + j) Then f2 = True: Exit For
            Next
            If f1 And f2 Then
                For j = 0 To 13
                    If Cells(n, i + j) = Cells(n - 1, i + j) Then
                        Cells(n, i + j).Interior.ColorIndex = c(cc)
                    End If
                Next
            ElseIf f1 Then
                For j = 0 To 6
                    If Cells(n, i + j) = Cells(n - 1, i + j) Then
                        Cells(n, i + j).Interior.ColorIndex = c(cc + 1)
                    End If
                Next
            ElseIf f2 Then
                For j = 7 To 13
                    If Cells(n, i + j) = Cells(n - 1, i + j) Then
                        Cells(n, i + j).Interior.ColorIndex = c(cc + 1)
                    End If
                Next
            End If
            cc = cc + 2
        Next
        n = n - 1
        k = k + 1
    Loop
End Sub