Excel VBA- 如何创建不重复的条件格式?
Excel VBA- How do I create conditional formatting without duplicates?
基本上我正在尝试制作适用于我工作簿中所有工作表的条件格式,因为我不知道有什么方法可以做到这一点我想我会制作一个 VBA 脚本来创建它适用于每个工作表。它有效,但如果它们已经具有格式,则会创建重复项,有什么办法可以防止这种情况发生?看到下图有相同条件格式的多个副本,因为我多次 运行 VBA 脚本,我想检查是否存在具有特定公式的条件格式以防止这种情况但没有任何幸运地找到了如何做到这一点。
重复的条件格式:
Sub Macro1()
Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets
If ws.Name = "macrotest" Then
ws.Activate
Dim myRange As Range
Set myRange = Range("A1:GJH5000")
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(Sheet2!$A=TRUE, OR(CELL(""col"") - 5 > CELL(""col"",A1), CELL(""col"") + 1
<CELL(""col"",A1), CELL(""row"") - 1 > CELL(""row"",A1), CELL(""row"") + 3
<CELL(""row"",A1)))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
With Selection.FormatConditions(1).ModifyAppliesToRange(myRange)
End With
End If
Next ws
End Sub
我可以使用 formatconditions.delete 删除任何现有的条件格式,但我不想删除其他条件格式。有什么想法吗?
由于您已将新添加的 FormatCondition
设置为 SetFirstPriority
的优先级,因此它变为 FormatConditions(1)
。
了解这一点后,您可以使用 FormatConditions(1).delete
删除该条件,重置将保留。
您也可以使用 Select Case
方法,但这将循环遍历单元格范围,并且需要相当长的时间才能 运行 遍历工作表中的每个单元格。
它适用于较小的范围。请参阅下面的代码:
Sub SomeSub()
Dim myCell
Dim Range1 As Range
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
Set Range1 = ws.Range("A1:GJH5000")
For Each cell In Range1
'Build your Formaul here
'First OR Function
OrFunc1 = Application.WorksheetFunction.Or(SomeFormula)
'Second OR Function
OrFunc2 = Application.WorksheetFunction.Or(SomeOtherFormula)
'Cells(1,1) reference Cells(RowRef, ColRef)
If ActiveWorkbook.Worksheets("Sheet2").Cells(1, 1).Value = True Then Func = True
'Your AND Function
TestFunc = Application.WorksheetFunction.And(Func, OrFunc1, OrFunc2)
If TestFunc = False Then
With cell.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If
'Put a BreakPoint On Next cell to check that it does what you want
Next cell
End Sub
基本上我正在尝试制作适用于我工作簿中所有工作表的条件格式,因为我不知道有什么方法可以做到这一点我想我会制作一个 VBA 脚本来创建它适用于每个工作表。它有效,但如果它们已经具有格式,则会创建重复项,有什么办法可以防止这种情况发生?看到下图有相同条件格式的多个副本,因为我多次 运行 VBA 脚本,我想检查是否存在具有特定公式的条件格式以防止这种情况但没有任何幸运地找到了如何做到这一点。
重复的条件格式:
Sub Macro1()
Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets
If ws.Name = "macrotest" Then
ws.Activate
Dim myRange As Range
Set myRange = Range("A1:GJH5000")
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=AND(Sheet2!$A=TRUE, OR(CELL(""col"") - 5 > CELL(""col"",A1), CELL(""col"") + 1
<CELL(""col"",A1), CELL(""row"") - 1 > CELL(""row"",A1), CELL(""row"") + 3
<CELL(""row"",A1)))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
With Selection.FormatConditions(1).ModifyAppliesToRange(myRange)
End With
End If
Next ws
End Sub
我可以使用 formatconditions.delete 删除任何现有的条件格式,但我不想删除其他条件格式。有什么想法吗?
由于您已将新添加的 FormatCondition
设置为 SetFirstPriority
的优先级,因此它变为 FormatConditions(1)
。
了解这一点后,您可以使用 FormatConditions(1).delete
删除该条件,重置将保留。
您也可以使用 Select Case
方法,但这将循环遍历单元格范围,并且需要相当长的时间才能 运行 遍历工作表中的每个单元格。
它适用于较小的范围。请参阅下面的代码:
Sub SomeSub()
Dim myCell
Dim Range1 As Range
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
Set Range1 = ws.Range("A1:GJH5000")
For Each cell In Range1
'Build your Formaul here
'First OR Function
OrFunc1 = Application.WorksheetFunction.Or(SomeFormula)
'Second OR Function
OrFunc2 = Application.WorksheetFunction.Or(SomeOtherFormula)
'Cells(1,1) reference Cells(RowRef, ColRef)
If ActiveWorkbook.Worksheets("Sheet2").Cells(1, 1).Value = True Then Func = True
'Your AND Function
TestFunc = Application.WorksheetFunction.And(Func, OrFunc1, OrFunc2)
If TestFunc = False Then
With cell.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
End If
'Put a BreakPoint On Next cell to check that it does what you want
Next cell
End Sub