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

Question

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

我正在尝试做的是添加一个 if 语句(或类似的东西(来引用另一个单元格，并且仅在腐蚀单元格包含大于 or = 的值为 .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