VBA - 条件格式化一行中的多个规则

VBA - conditional formatting mutiple rules in one row

我想通过 VBA 应用条件格式,如果列 E 包含例如 1ST,那么我想对其旁边的 28 个单元格使用多个条件格式规则。

此时我使用

Sub SetFormulasFormat()
With ActiveSheet
    For Each cl In Application.Intersect(.Columns("E"), .UsedRange)
        ' found upper row of the data in table
        If UCase(cl.Text) = "1ST" Then
                    cl.Resize(, 1).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
                     Formula1:="=1"
                    cl.Resize(, 1).FormatConditions(1).Interior.Color = vbRed
                    
                    cl.Resize(, 2).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
                     Formula1:="=3"
                    cl.Resize(, 2).FormatConditions(2).Interior.Color = vbRed
                

            End If
        
    Next cl
End With

结束子

但是我没有应用第二条规则。

我的例子excel

有人可以帮助我吗?

尝试:

Sub SetFormulasFormat()
Application.ScreenUpdating = False
Dim cl As Range
With ActiveSheet
    For Each cl In Application.Intersect(.Columns("E"), .UsedRange)
        ' found upper row of the data in table
        If UCase(cl.Value) = "1ST" Then
            .Range("F" & cl.Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=1" 'apply CF rule to 1 single cell in same row
            .Range("F" & cl.Row).FormatConditions(1).Interior.Color = vbRed
            
            .Range("G" & cl.Row & ",H" & cl.Row).FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, Formula1:="=3" 'apply CF rule to 2 different cells in same row (Separate each cell with , like G2,H2...)
            .Range("G" & cl.Row & ",H" & cl.Row).FormatConditions(1).Interior.Color = vbRed
        End If
        
    Next cl
End With
Application.ScreenUpdating = True
End Sub

这将在您指定的每个范围内应用单个 CF 规则。我输入了在单个单元格或 2 个单元格中创建 CF 规则的示例,但您可以根据需要进行调整。

可变条件格式

  • '* 表示您必须在何处更改其他值而不是 1ST 的代码,例如CUCA.

代码

Option Explicit

Sub SetFormulasFormat()
    Const hRows As Long = 1
    Const cOffset As Long = 1
    Dim cl As Range
    
    Dim Offsets As Variant
    Offsets = Array(1, 2, 3)
    Dim firstValues As Variant
    firstValues = Array(1, 3, 5) '*
'    Dim cucaValues As Variant
'    cucaValues = Array(1, 3, 5) '*
    
    Dim cLower As Long: cLower = LBound(Offsets)
    Dim cUpper As Long: cUpper = UBound(Offsets)
    
    Dim fcols As Long: fcols = cUpper - cLower + 1
    With ActiveSheet
        Dim crg As Range
        With Intersect(.Columns("E"), .UsedRange)
            Set crg = .Resize(.Rows.Count - hRows).Offset(hRows)
        End With
    End With
    With crg
        .Resize(, fcols).Offset(, cOffset).FormatConditions.Delete
        Dim n As Long
        For Each cl In .Cells
            Select Case True
            Case UCase(cl.Value) = "1ST" '*
                For n = cLower To cUpper
                    With cl.Offset(, Offsets(n))
                        .FormatConditions.Add Type:=xlCellValue, _
                            Operator:=xlLess, Formula1:="=" & firstValues(n) '*
                        With .FormatConditions(1)
                            .Font.Color = vbWhite
                            .Interior.Color = vbRed
                        End With
                    End With
                Next n
'            Case UCase(cl.Value) = "CUCA" '*
'                For n = cLower To cUpper
'                    With cl.Offset(, Offsets(n))
'                        .FormatConditions.Add Type:=xlCellValue, _
'                            Operator:=xlLess, Formula1:="=" & cucaValues(n) '*
'                        With .FormatConditions(1)
'                            .Font.Color = vbWhite
'                            .Interior.Color = vbRed
'                        End With
'                    End With
'                Next n
            End Select
        Next cl
    End With
End Sub