Question

我设法开发了一个代码，以便在条件匹配时突出显示单元格。但是所有单元格都具有相同的颜色代码，难以识别。颜色代码37在这里使用。我怎样才能在33-46之间更改我的颜色代码（随机选择的颜色对我来说都很好。

Sub Button1_Click()
    Dim rownumber As Integer
    Dim ColumnC, ColumnF, ColumnC1, ColumnF1 As String
    Dim ColumnD, ColumnD1 As Single
    Dim subrownumber As Integer
    Dim Condition As Boolean
    rownumber = 1
    Do
        ColumnD = Cells(rownumber, 4).Value
        ColumnC = Cells(rownumber, 3).Value
        ColumnF = Cells(rownumber, 6).Value
        Condition = False
        If (ColumnD < 0) Then
            subrownumber = 1
            Do
                ColumnD1 = Cells(subrownumber, 4).Value
                ColumnC1 = Cells(subrownumber, 3).Value
                ColumnF1 = Cells(subrownumber, 6).Value
                If (ColumnD1 = ColumnD * -1 And ColumnF1 = ColumnF And _
                    ColumnC1 = ColumnC) And _
                    Cells(subrownumber, 4).Interior.ColorIndex <> 37 And _
                    Cells(rownumber, 4).Interior.ColorIndex <> 37 Then
                        Cells(subrownumber, 4).Interior.ColorIndex = 37
                        Cells(subrownumber, 3).Interior.ColorIndex = 37
                        Cells(subrownumber, 6).Interior.ColorIndex = 37
                        Cells(rownumber, 4).Interior.ColorIndex = 37
                        Cells(rownumber, 3).Interior.ColorIndex = 37
                        Cells(rownumber, 6).Interior.ColorIndex = 37
                        Condition = True
                End If
                subrownumber = subrownumber + 1
            Loop Until IsEmpty(Cells(subrownumber, 4)) Or Condition = True
        End If
        rownumber = rownumber + 1
    Loop Until IsEmpty(Cells(rownumber, 4))
End Sub

Answer 1

我会将你的颜色索引作为一个数字，比方说33，并将它添加为subrownumber的MOD。如果你想要10种不同的颜色使用subrownumber MOD 10,8种不同的颜色使用subrownumber MOD 8等。

您还必须更改条件以检查ColorIndex的范围而不是仅检查一个值，因此您可能希望首先在工作表上设置相同的所有颜色（或删除颜色）。例如，如果你从一个小于33的ColorIndex开始，那么你可以在每个循环中添加一个subrownubmer MOD 10到33，从不冒险破坏条件。

所以没有底层数据，我没有运行这段代码，但我会这样做：

Sub Button1_Click()
    Dim rownumber As Integer
    Dim ColumnC, ColumnF, ColumnC1, ColumnF1 As String
    Dim ColumnD, ColumnD1 As Single
    Dim subrownumber As Integer
    Dim Condition As Boolean
    rownumber = 1
    Do
        ColumnD = Cells(rownumber, 4).Value
        ColumnC = Cells(rownumber, 3).Value
        ColumnF = Cells(rownumber, 6).Value
        Condition = False
        If (ColumnD < 0) Then
            subrownumber = 1
            Do
                ColumnD1 = Cells(subrownumber, 4).Value
                ColumnC1 = Cells(subrownumber, 3).Value
                ColumnF1 = Cells(subrownumber, 6).Value
                If (ColumnD1 = ColumnD * -1 And ColumnF1 = ColumnF And _
                    ColumnC1 = ColumnC) And _
                    Cells(subrownumber, 4).Interior.ColorIndex < 33 And _
                    Cells(rownumber, 4).Interior.ColorIndex < 33 Then
                        Cells(subrownumber, 4).Interior.ColorIndex = _
                            (subrownumber MOD 10) + 33
                        Cells(subrownumber, 3).Interior.ColorIndex = _
                            (subrownumber MOD 10) + 33
                        Cells(subrownumber, 6).Interior.ColorIndex = _
                            (subrownumber MOD 10) + 33
                        Cells(rownumber, 4).Interior.ColorIndex = _
                            (subrownumber MOD 10) + 33
                        Cells(rownumber, 3).Interior.ColorIndex = _
                            (subrownumber MOD 10) + 33
                        Cells(rownumber, 6).Interior.ColorIndex = _
                            (subrownumber MOD 10) + 33
                        Condition = True
                End If
                subrownumber = subrownumber + 1
            Loop Until IsEmpty(Cells(subrownumber, 4)) Or Condition = True
        End If
        rownumber = rownumber + 1
    Loop Until IsEmpty(Cells(rownumber, 4))
End Sub

这应该确保你永远不会得到一个上面或下面有相同颜色的单元格（除非它是你开始的默认颜色）。

在代码中使用多种突出显示颜色

1 个答案: