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

时间:2018-06-14 22:57:22

标签: excel excel-vba if-statement conditional-formatting vba

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

我尝试做的是添加一个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

非常感谢任何帮助,谢谢!

1 个答案:

答案 0 :(得分: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