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
我想通过 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