excel - 循环遍历范围内的行，并根据该行中的单元格将条件格式应用于整列

Question

我在 Excel 工作表中有下表，名为 Teams ;

<表类=“s-表”> <标题> 团队 TLA C 颜色 <正文> 法拉利 FER FER EE161F 雷诺 任 任 00B0F0 威廉姆斯F1 WIL WIL 000066

C中的值列直接取自TLA列 =[@TLA] 。 COLOUR中的值列是我运行宏时想要设置的文本和背景颜色。我还希望此条件格式适用于整个列，而不仅仅是特定的单元格。我已经将第一部分与以下子程序一起使用；

Sub SetConditionalFormatting()
    Dim rng As Range
    Dim row As Range
    Dim position As Long
    Dim colourColumnIndex As Integer
    Dim tlaColumnIndex As Integer
    
    Set rng = Range("Teams")
    
    colourColumnIndex = rng.ListObject.ListColumns("COLOUR").Range.Column
    tlaColumnIndex = rng.ListObject.ListColumns("C").Range.Column
    
    For Each row In rng
        Dim colorCell As Range
        Dim tlaCell As Range
        Dim hex As String
        Dim color
        
        Set colorCell = Cells(row.row, colourColumnIndex)
        Set tlaCell = Cells(row.row, tlaColumnIndex)
        hex = colorCell.Value
        color = RGB(Application.Hex2Dec(Left(hex, 2)), Application.Hex2Dec(Mid(hex, 3, 2)), Application.Hex2Dec(Right(hex, 2)))
    
        tlaCell.FormatConditions.Delete
        
        tlaCell.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=tlaCell.Value
        tlaCell.FormatConditions(1).Interior.color = color
        tlaCell.FormatConditions(1).Font.color = color
        tlaCell.FormatConditions(1).Borders.color = RGB(19, 21, 29)
        tlaCell.FormatConditions(1).StopIfTrue = False
    Next
End Sub

但是，这仅将条件格式应用于该特定单元格(例如$C$2)。我需要的是要应用于 $C$2:$C$4 的格式，就像我选择整个 C 一样列，然后手动将格式复制/粘贴到其他表格。

我已添加tlaCell.FormatConditions(1).ModifyAppliesToRange Range("Teams[C]")作为最后一次调用，尝试使此工作正常进行，但它不是将格式一次应用于整个列，而是应用第一个屏幕截图中所示的格式。我需要的是设置“适用于”范围，如第二个屏幕截图中所示。知道我怎样才能做到这一点吗？

编辑:由于 Foxfire 的建议，设法让它工作，这是我最终得到的代码；

Sub SetConditionalFormatting()
    Dim rng As Range
    Dim row As Range
    Dim position As Long
    Dim colourColumnIndex As Integer
    Dim tlaColumnIndex As Integer
    Dim formattingColumn As Range
    Set rng = Range("Teams")
    Dim colours
    Set colours = CreateObject("Scripting.Dictionary")
    
    colourColumnIndex = rng.ListObject.ListColumns("COLOUR").Range.Column
    tlaColumnIndex = rng.ListObject.ListColumns("C").Range.Column
    
    Set formattingColumn = Range("Teams[C]")
    
    formattingColumn.FormatConditions.Delete
    
    For Each row In rng
        Dim colorCell As Range
        Dim tlaCell As Range
        
        Dim hex As String
        
        
        Set colorCell = Cells(row.row, colourColumnIndex)
        Set tlaCell = Cells(row.row, tlaColumnIndex)
        hex = colorCell.Value
        
        
        If Not colours.Exists(tlaCell.Value) Then
            colours.Add Key:=tlaCell.Value, Item:=hex
        End If
    Next
    
    Dim tla As Variant
    
    Dim index As Integer
    index = 1
    For Each tla In colours.Keys
        hex = colours(tla)
        Dim color
        color = RGB(Application.Hex2Dec(Left(hex, 2)), Application.Hex2Dec(Mid(hex, 3, 2)), Application.Hex2Dec(Right(hex, 2)))
        
        formattingColumn.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=tla
        formattingColumn.FormatConditions(index).Interior.color = color
        formattingColumn.FormatConditions(index).Font.color = color
        formattingColumn.FormatConditions(index).Borders.color = RGB(19, 21, 29)
        formattingColumn.FormatConditions(index).StopIfTrue = False
        index = index + 1
    Next
End Sub

我会看看是否可以清理一下，但这可以正常工作。

Answer 1

我使用字典根据您的数据制作了一个示例。

Sub test()
Dim i As Long
Dim LR As Long
Dim FormatRng As Range
Dim Dic As Object
Dim MyKey As Variant
Dim hex As String
Dim Mycolor As Variant


Set Dic = CreateObject("Scripting.Dictionary")

LR = Range("A" & Rows.Count).End(xlUp).Row 'last used row in column A

Set FormatRng = Range("B2:B" & LR) 'the range where I want to apply my CF rules

FormatRng.FormatConditions.Delete

For i = 2 To LR '2 is the first row where my data is
    'loop to create a Dicionary of unique items of C,COLOUR values
    If Dic.Exists(Range("C" & i).Value) = False Then Dic.Add Range("C" & i).Value, Range("D" & i).Value
Next i

'loop trough dictionary to apply cf rules to FormatRng

i = 1
For Each MyKey In Dic.Keys
    hex = Dic(MyKey)
    Mycolor = RGB(Application.Hex2Dec(Left(hex, 2)), Application.Hex2Dec(Mid(hex, 3, 2)), Application.Hex2Dec(Right(hex, 2)))
    With FormatRng
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=MyKey
        .FormatConditions(i).Interior.Color = Mycolor
        .FormatConditions(i).Font.Color = vbWhite
        .FormatConditions(i).Borders.Color = RGB(19, 21, 29)
        .FormatConditions(i).StopIfTrue = False
    End With
    i = i + 1
Next MyKey

Set Dic = Nothing
Set FormatRng = Nothing


End Sub

我得到的输出:

Excel VBA Dictionary – A Complete Guide