Question

我目前有一个将条件格式应用于单元格的宏（在这里它是单元格＆＃34; G＆＃34;但我认为如果我能够将宏应用条件格式更好我选择的任何单元格，以便我不仅限于我在宏中设置的单元格。

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

感谢您的帮助！

条件格式宏到活动列

0 个答案: