基于单元格颜色的条件格式

Conditional Formatting based on cell color

考虑一个包含 3 列的列表。

第 2 列是通过 VBA 代码填充的,国定假日用相同的代码涂成蓝色,但母亲节等特殊日子不是。用户无法操作此列。

第 3 列由 sheet 上的用户填充。如果用户在第三列中添加了一个事件,则该行通过条件格式显示为绿色。

问题是,如果事件恰逢国定假日,蓝色会被覆盖。

我的目标是添加第二个条件格式规则来检查:

  1. 添加了用户定义的事件
  2. 该行的颜色为蓝色

如果两个条件都满足,将设置图案颜色、图案样式和背景颜色,因此我将获得两种颜色的组合。

如果只满足第一个条件,则只设置背景色。

简而言之:我需要一种方法来检查单元格颜色并将其合并到条件格式规则中。

我认为您需要创建一个新的 VBA 函数来确定单元格是否为特定颜色。例如,以下代码可用于确定区域中的单元格是否为蓝色:

If range.Interior.Color = RGB(0, 0, 256) Then
    colorAction = "Something"

然后,从单元格的宏中调用 VBA 函数。

=CheckIfBlue(B5)

艾伦怀亚特 good article on conditionally taking an action depending on a cell's color

您必须添加 3 条规则

R1: and(user defined event; not(Holiday)) > green.


R2: and(not(user defined event); Holiday) > blue.


R3: and(user defined event; Holiday) > 混合颜色。


勾选条件格式对话框中R1、R2最右边的checkBox。

我解决这个问题的方法就是放弃所有条件格式并添加一个 Worksheet_Change() 事件。相应地检查条件和格式。

请注意,这是一种非常费力的方法,但它完成了工作。如果条件格式中的构建包含一种将格式作为可能条件包括在内的方法,那将会容易得多。

作为旁注,因为 sheet 是由代码添加的,它们本身不包含此代码,但它位于名为 clsEventsClassModule 中。

ClassModule

中的声明
Public WithEvents chngSht As Worksheet

Module 中声明添加工作的子程序sheet

Dim arrShts() as New clsEvents

添加 sheet 或打开工作簿时调用此子程序

Sub shtEvents()
    Dim sht As Worksheet

    Erase arrShts
    ReDim arrShts(0)

    For Each sht In ThisWorkbook.Worksheets
        If Not sht.Name = "Menu" And Not sht.Name = "Tabellen" Then
            If UBound(arrShts) = 0 Then
                ReDim arrShts(1 To 1)
            Else
                ReDim Preserve arrShts(1 To UBound(arrShts) + 1)
            End If
            Set arrShts(UBound(arrShts)).chngSht = sht
        End If
    Next

End Sub

执行条件格式的实际代码。

Private Sub chngSht_Change(ByVal Target As Range)
    Dim sht As Worksheet
    Dim x As Long, y As Long
    Dim arrRange(1 To 4) As Range
    Dim blnWeekend As Boolean

    Set sht = Target.Parent
    With sht
        .Unprotect
        x = 1
        For y = 1 To 13 Step 4
            Set arrRange(x) = .Range(.Cells(4, y).Offset(0, 2), .Cells(.Rows.Count, y).End(xlUp).Offset(0, 2))          'Gather the 4 quarters of the year in 4 seperate ranges in an array.
            x = x + 1
        Next
        For x = 1 To 4                                                                                                  'Iterate through the quarters of the year
            If Not Intersect(Target, arrRange(x)) Is Nothing Then                                                       'Check if the event changed is in Q1, Q2, Q3 or Q4, or not
                blnWeekend = fnblnWeekend(Target.Offset(0, -2))                                                         'Check if the date falls in a weekend
                With .Range(Target, Target.Offset(0, -2)).Interior
                    Select Case True
                        Case Target = Empty And Target.Offset(0, -1) = Empty And Not blnWeekend                         'Event removed, no national holiday or other special day, and date is not a weekend
                            .Color = RGB(255, 255, 255)
                            .PatternColor = xlAutomatic
                            .Pattern = xlNone
                        Case Target = Empty And Target.Offset(0, -1) = Empty And blnWeekend                             'Event removed, no national holiday or other special day, and date is in a weekend
                            .Color = RGB(255, 255, 204)
                            .PatternColor = xlAutomatic
                            .Pattern = xlSolid
                        Case Target = Empty And Not Target.Offset(0, -1) = Empty And Not blnWeekend                     'Event removed, possibly national holiday or other special day, and dat is not in a weekend
                            Select Case True
                                Case Target.Offset(0, -1).Interior.Color = RGB(91, 155, 213)                            'Color of changed date indicates a National Holiday
                                    .Color = RGB(91, 155, 213)
                                    .PatternColor = xlAutomatic
                                    .Pattern = xlSolid
                                Case Target.Offset(0, -1).Interior.Color = RGB(198, 239, 206)                           'Color of changed date does not indicate a National Holiday
                                    .Color = RGB(255, 255, 255)
                                    .PatternColor = xlAutomatic
                                    .Pattern = xlNone
                            End Select
                        Case Target = Empty And Not Target.Offset(0, -1) = Empty And blnWeekend                         'Event removed, possibly a national holiday or other special day, and the date is in a weekend
                            Select Case True
                                Case Target.Offset(0, -1).Interior.Color = RGB(91, 155, 213)                            'Color of changed date indicates a National Holiday
                                    .Color = RGB(91, 155, 213)
                                    .PatternColor = xlAutomatic
                                    .Pattern = xlSolid
                                Case Target.Offset(0, -1).Interior.Color = RGB(255, 255, 204)                           'Color of changed date does not indicate a National Holiday
                                    .Color = RGB(255, 255, 204)
                                    .PatternColor = xlAutomatic
                                    .Pattern = xlSolid
                            End Select
                        Case Not Target = Empty And Target.Offset(0, -1) = Empty And Not blnWeekend                     'Event added, no National Holiday or other special day, and date is not a weekend
                            .Color = RGB(198, 239, 206)
                            .PatternColor = xlAutomatic
                            .Pattern = xlSolid
                        Case Not Target = Empty And Target.Offset(0, -1) = Empty And blnWeekend                         'Event added, no National Holiday or other special day, and date is in a weekend
                            .Color = RGB(255, 255, 204)
                            .PatternColor = RGB(198, 239, 206)
                            .Pattern = xlUp
                        Case Not Target = Empty And Not Target.Offset(0, -1) = Empty And Not blnWeekend                 'Event added, possibly National Holiday or other special day, and the date is not in a weekend
                            Select Case True
                                Case Target.Offset(0, -1).Interior.Color = RGB(91, 155, 213)                            'Color of changed date indicates a National Holiday
                                    .Color = RGB(91, 155, 213)
                                    .PatternColor = RGB(198, 239, 206)
                                    .Pattern = xlUp
                                Case Target.Offset(0, -1).Interior.Color = RGB(255, 255, 255)                           'Color of changed date does not indicate a National Holiday
                                    .Color = RGB(198, 239, 206)
                                    .PatternColor = xlAutomatic
                                    .Pattern = xlSolid
                            End Select
                        Case Not Target = Empty And Not Target.Offset(0, -1) = Empty And blnWeekend                     'Event added, possibly National Holiday or otheer special day, and date is not a weekend
                            Select Case True
                                Case Target.Offset(0, -1).Interior.Color = RGB(91, 155, 213)                            'Color of changed date indicates a National Holiday
                                    .Color = RGB(91, 155, 213)
                                    .PatternColor = RGB(198, 239, 206)
                                    .Pattern = xlUp
                                Case Target.Offset(0, -1).Interior.Color = RGB(255, 255, 204)                           'Color of changed date does not indicate a National Holiday
                                    .Color = RGB(255, 255, 204)
                                    .PatternColor = RGB(198, 239, 206)
                                    .Pattern = xlUp
                            End Select
                    End Select
                End With
                Exit For
            End If
        Next
        .Protect
    End With

End Sub