条件格式宏中的格式条件帮助

Question

我有一个im使用的宏，它有2个部分，第1部分是根据关键字进行颜色编码的上部，下部则突出显示了重复的单元格。宏的第一部分的格式条件使其仅在列“ D”中对应的单元格的值为.6或更大时才起作用，我需要相同的东西才能对宏的第二部分进行操作，但是i似乎无法使其正常工作。有什么想法吗？

宏的第一部分中我需要与之类似的格式条件是

FormatConditions.Add xlExpression, Formula1:="=AND(D1>0.6,ISNUMBER(SEARCH(""" & aKeyColors(i, 1) & """,G1)))"

宏：

Sub oneSixColorCodingPluskey()
'
' oneSixColorCodingPluskey Macro
'

    Dim wb As Workbook
    Dim wsKey As Worksheet
    Dim wsFees As Worksheet
    Dim aKeyColors(1 To 29, 1 To 2) As Variant
    Dim aOutput() As Variant
    Dim sKeyShName As String
    Dim i As Long, j As Long

    Set wb = ActiveWorkbook
    Set wsFees = wb.Sheets("Fees")
    sKeyShName = "Color Coding Key"

    On Error Resume Next
    Set wsKey = wb.Sheets(sKeyShName)
    On Error GoTo 0
    If wsKey Is Nothing Then
        Set wsKey = wb.Sheets.Add(After:=ActiveSheet)
        wsKey.Name = sKeyShName
        With wsKey.Range("A1:B1")
            .Value = Array("Word", "Color")
            .HorizontalAlignment = xlCenter
            .Font.Bold = True
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
        End With
    Else
        wsKey.Range("A2:B" & wsKey.Rows.Count).Clear
    End If

    aKeyColors(1, 1) = "Strategize":    aKeyColors(1, 2) = 10053120
    aKeyColors(2, 1) = "Coordinate":    aKeyColors(2, 2) = 10053120
    aKeyColors(3, 1) = "Develop":       aKeyColors(3, 2) = 10053120
    aKeyColors(4, 1) = "Draft":         aKeyColors(4, 2) = 10053120
    aKeyColors(5, 1) = "Organize":      aKeyColors(5, 2) = 10053120
    aKeyColors(6, 1) = "Finalize":      aKeyColors(6, 2) = 10053120
    aKeyColors(7, 1) = "Maintain":      aKeyColors(7, 2) = 10053120
    aKeyColors(8, 1) = "Prepare":       aKeyColors(8, 2) = 10053120
    aKeyColors(9, 1) = "Rework":        aKeyColors(9, 2) = 10053120
    aKeyColors(10, 1) = "Revise":       aKeyColors(10, 2) = 10053120
    aKeyColors(11, 1) = "Review":       aKeyColors(11, 2) = 10053120
    aKeyColors(11, 1) = "Analysis":       aKeyColors(11, 2) = 10053120
    aKeyColors(11, 1) = "Analyze":       aKeyColors(11, 2) = 10053120
    aKeyColors(12, 1) = "Follow Up":    aKeyColors(12, 2) = 10053120
    aKeyColors(12, 1) = "Follow-Up":    aKeyColors(12, 2) = 10053120
    aKeyColors(13, 1) = "Maintain":     aKeyColors(13, 2) = 10053120
    aKeyColors(14, 1) = "Address":      aKeyColors(14, 2) = 10053120
    aKeyColors(15, 1) = "Attend":       aKeyColors(15, 2) = 10092441
    aKeyColors(16, 1) = "Confer":       aKeyColors(16, 2) = 10092441
    aKeyColors(17, 1) = "Meet":         aKeyColors(17, 2) = 16751103
    aKeyColors(18, 1) = "Work With":    aKeyColors(18, 2) = 16751103
    aKeyColors(19, 1) = "Correspond":   aKeyColors(19, 2) = 16750950
    aKeyColors(20, 1) = "Email":        aKeyColors(20, 2) = 16750950
    aKeyColors(20, 1) = "E-mail":        aKeyColors(20, 2) = 16750950
    aKeyColors(21, 1) = "Phone":        aKeyColors(21, 2) = 6697881
    aKeyColors(22, 1) = "Telephone":    aKeyColors(22, 2) = 6697881
    aKeyColors(23, 1) = "Call":         aKeyColors(23, 2) = 6697881
    aKeyColors(24, 1) = "Committee":    aKeyColors(24, 2) = 3394611
    aKeyColors(25, 1) = "Various":      aKeyColors(25, 2) = 32768
    aKeyColors(26, 1) = "Team":         aKeyColors(26, 2) = 13056
    aKeyColors(27, 1) = "Print":        aKeyColors(27, 2) = 10092543
    aKeyColors(28, 1) = "Wip":          aKeyColors(28, 2) = 65535
    aKeyColors(29, 1) = "Circulate":    aKeyColors(29, 2) = 39372

    wsFees.Cells.FormatConditions.Delete
    ReDim aOutput(1 To UBound(aKeyColors, 1), 1 To 2)
    With wsFees.Columns("G")
        For i = LBound(aKeyColors, 1) To UBound(aKeyColors, 1)
            If WorksheetFunction.CountIf(.Cells, "*" & aKeyColors(i, 1) & "*") > 0 Then
                j = j + 1
                aOutput(j, 1) = aKeyColors(i, 1)
                aOutput(j, 2) = aKeyColors(i, 2)
                .FormatConditions.Add xlExpression, Formula1:="=AND(D1>0.6,ISNUMBER(SEARCH(""" & aKeyColors(i, 1) & """,G1)))"
                .FormatConditions(.FormatConditions.Count).Interior.Color = aKeyColors(i, 2)
            End If
        Next i
    End With

    If j > 0 Then
        wsKey.Range("A2").Resize(j, 1).Value = aOutput
    For i = 1 To j
            wsKey.Cells(i + 1, "B").Interior.Color = aOutput(i, 2)
        Next i
        wsKey.Columns("A").EntireColumn.AutoFit
    End If

    With wsFees.Columns("G")
        .FormatConditions.AddUniqueValues
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).DupeUnique = xlDuplicate
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 192
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With

End Sub

感谢您提供的任何帮助！

Answer 1

使用COUNTIFS（）的基于公式的CF可能会完成这项工作。

例如