Excel VBA-如何创建不重复的条件格式？

Question

基本上，我正在尝试制作适用于我工作簿中所有工作表的条件格式，因为我不知道有什么方法可以做到这一点，我想我会制作一个 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$1=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 删除任何现有的条件格式，但我不想删除其他条件格式。有什么想法吗？

Answer 1

由于您已将新添加的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