将 If 语句添加到条件格式 VBA 宏

Question

我有一个宏，它有条件地格式化列中的单元格，其颜色偏向于包含的关键字，然后将使用的关键字和相应的颜色报告给另一个工作表。

我想要做的是添加一个 if 语句（或类似的东西）来引用另一个单元格，并且只有在对应的单元格包含大于或 = 到 .6 的值时才格式化单元格让我说我想要引用“D”列中的单元格

因此，当它工作时，它应该检查“F”列中的单元格中的关键字，然后检查“D”列以查看它的值是否大于或 = 到 .6 以及是否满足这两个条件将对列“F”中的单元格进行颜色编码

这里是：

Sub ColorCodingPluskey()
'
' ColorCodingPluskey Macro
'

    Dim wb As Workbook
    Dim wsKey As Worksheet
    Dim wsFees As Worksheet
    Dim aKeyColors(1 To 20, 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) = 13421619
    aKeyColors(3, 1) = "Committee":     aKeyColors(3, 2) = 16777062
    aKeyColors(4, 1) = "Attention":     aKeyColors(4, 2) = 2162853
    aKeyColors(5, 1) = "Work":          aKeyColors(5, 2) = 5263615
    aKeyColors(6, 1) = "Circulate":     aKeyColors(6, 2) = 10066431
    aKeyColors(7, 1) = "Numerous":      aKeyColors(7, 2) = 13158
    aKeyColors(8, 1) = "Follow up":     aKeyColors(8, 2) = 39372
    aKeyColors(9, 1) = "Attend":        aKeyColors(9, 2) = 65535
    aKeyColors(10, 1) = "Attention to": aKeyColors(10, 2) = 65535
    aKeyColors(11, 1) = "Print":        aKeyColors(11, 2) = 10092543
    aKeyColors(12, 1) = "WIP":          aKeyColors(12, 2) = 13056
    aKeyColors(13, 1) = "Prepare":      aKeyColors(13, 2) = 32768
    aKeyColors(14, 1) = "Develop":      aKeyColors(14, 2) = 3394611
    aKeyColors(15, 1) = "Participate":  aKeyColors(15, 2) = 10092441
    aKeyColors(16, 1) = "Organize":     aKeyColors(16, 2) = 13369548
    aKeyColors(17, 1) = "Various":      aKeyColors(17, 2) = 16751103
    aKeyColors(18, 1) = "Maintain":     aKeyColors(18, 2) = 16724787
    aKeyColors(19, 1) = "Team":         aKeyColors(19, 2) = 16750950
    aKeyColors(20, 1) = "Address":      aKeyColors(20, 2) = 6697881

    wsFees.Cells.FormatConditions.Delete
    ReDim aOutput(1 To UBound(aKeyColors, 1), 1 To 2)
    With wsFees.Columns("F")
        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 xlTextString, String:=aKeyColors(i, 1), TextOperator:=xlContains
                .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

End Sub

非常感谢任何帮助，谢谢！

Answer 1

在这里，我刚刚将格式条件更改为公式，以便它检查 D 中的值以及是否在 F 中找到文本。让我知道你的进展情况。

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(FIND(""" & aKeyColors(i, 1) & """,F1)))"
          .FormatConditions(.FormatConditions.Count).Interior.Color = aKeyColors(i, 2)
     End If
Next i