带键的条件格式宏

Question

我正在尝试创建一个宏来有条件地格式化列。因此，它将根据单元格中包含的关键字更改单元格的填充颜色，我也在尝试这样做，以便该宏将创建一个新的 sheet 并输出一个仅包含关键字和填充颜色的键对于正在格式化的列中包含的关键字。

因此，例如，如果我有一个包含 30 个单词的关键字列表，并且在这种情况下该列仅使用了 9 个单词，那么它将在单独的 sheet 上输出一个仅包含 9 个单词的键使用的单词以及相应的填充颜色。

这是宏当前的样子，它将有条件地格式化列并创建一个新的 sheet 输出一个键，但它包含所有关键字，即使它们未被使用。

Sub ColorCoringPluskey()
'
' ColorCoringPluskey Macro
'

'
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Color Coding Key"
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Word"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Color"
    Range("A1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1:B1").Select
    Selection.Font.Bold = True
    Selection.Font.Underline = xlUnderlineStyleSingle
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Strategize"
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Coordinate"
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "Committee"
    Range("A5").Select
    ActiveCell.FormulaR1C1 = "Attention"
    Range("A6").Select
    ActiveCell.FormulaR1C1 = "Work"
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "Criculate"
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "Numerous"
    Range("A9").Select
    ActiveCell.FormulaR1C1 = "Follow up"
    Range("A10").Select
    ActiveCell.FormulaR1C1 = "Attend" & Chr(10) & "Attend to"
    Range("A11").Select
    ActiveCell.FormulaR1C1 = "Attention to"
    Range("A12").Select
    ActiveCell.FormulaR1C1 = "Print"
    Range("A13").Select
    ActiveCell.FormulaR1C1 = "WIP"
    Range("A14").Select
    ActiveCell.FormulaR1C1 = "Prepare" & Chr(10) & "Prepare for"
    Range("A15").Select
    ActiveCell.FormulaR1C1 = "Develop"
    Range("A16").Select
    ActiveCell.FormulaR1C1 = "Participate"
    Range("A17").Select
    ActiveCell.FormulaR1C1 = "Organize"
    Range("A18").Select
    ActiveCell.FormulaR1C1 = "Various"
    Range("A19").Select
    ActiveCell.FormulaR1C1 = "Maintain"
    Range("A20").Select
    ActiveCell.FormulaR1C1 = "Team" & Chr(10) & "Team call"
    Range("A21").Select
    ActiveCell.FormulaR1C1 = "Address"
    Range("B2").Select
    Columns("A:A").ColumnWidth = 13.43
    Columns("B:B").ColumnWidth = 31.43
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10053120
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B3").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13421619
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16777062
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Fees").Select
    Columns("G:G").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Strateg", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10053120
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Coordinate", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13421619
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Committee", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 16777062
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Attention", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 2162853
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Work", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 5263615
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Circulate", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10066431
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Sheets("Color Coding Key").Select
    Range("B5").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 2162853
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B6").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5263615
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B7").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10066431
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B8").Select
    Sheets("Fees").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Numer", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13158
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Follow Up", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="atten", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Print", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Sheets("Color Coding Key").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13158
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B9").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 39372
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B10").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B11").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B11").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B12").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092543
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Fees").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="WIP", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13056
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Prep", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 32768
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="develop", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 3394611
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Sheets("Color Coding Key").Select
    Range("B13").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13056
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B14").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 32768
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B15").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 3394611
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B16").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10092441
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Fees").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Particip", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 10092441
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Organize", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13369548
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Various", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 16751103
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Sheets("Color Coding Key").Select
    Range("B17").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 13369548
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B18").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16751103
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B19").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16724787
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B20").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 16750950
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B21").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 6697881
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Sheets("Fees").Select
    Selection.FormatConditions.Add Type:=xlTextString, String:="Maintain", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 16724787
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="Team", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 16750950
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="address", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 6697881
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Sheets("Fees").Select
End Sub

Answer 1

我想这就是您要找的。请注意，它没有找到 "Attention to"，因为它首先找到 "Attention"。要成功，请按查找的优先级顺序排列它们（首先找到列表），或者确保您不会像那样重复部分匹配。

Sub ColorCoringPluskey()
'
' ColorCoringPluskey 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("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 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

带键的条件格式宏

Conditional Formatting macro with key

excel

vba

conditional-formatting