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