基於值是否在文本列表中的VBA條件格式單元格

Question

我有以下代碼：

Sub Japan()

Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage

    If Cell.Value = "A" Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If

    If Cell.Value = "B" Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If

    If Cell.Value = "C" Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If

    If Cell.Value = "D" Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If

    If Cell.Value = "E" Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If

Next

End Sub

這將找到具有A，B，C，D，E作為值的任何單元格，然后將整個行都塗成紅色。

基本上，我還有數百個要查找的值。 我將它們存儲在另一個excel文件中（可以很容易地將其存儲在文本文件中）。 我該如何引用它們？ 即，如果單元格值在此文本列表中，請執行此操作。

Answer 1

聽起來您想要一個包含唯一值的Set數據結構 ，並且可以在其上使用Exist方法。

例如，您所需的用法是這樣。

Set MySet = LoadRedValueSet(???) ' explain later
Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
    If MySet.Exists(Cell.Value) Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If
Next

太糟糕了， Set是一個保留關鍵字，VBA不提供Set對象。 但是，它確實提供了一個Dictionary對象，可以像Set那樣濫用它。 您需要參考Scripting Runtime Library才能首先使用它 。 用法將完全如上所述。 但是首先我們需要定義LoadRedValueSet()

假設您能夠加載將這些值保存為Excel工作表的任何文件。 我將不會解釋如何在Excel中打開各種文件類型，因為有許多答案比我能詳細地詳細說明。 但是一旦您將值的范圍添加到集合中，我們就可以將它們添加到字典中。

Private Function LoadRedValueSet(valueRange As Range) As Dictionary

    Dim result As New Dictionary

    Dim cell As Range
    For Each cell In valueRange.Cells
       result(cell.value) = Nothing
    Next cell

    Set LoadRedValueSet = result

End Function

字典是具有鍵->值對的映射對象。 密鑰實際上是我們想要的一組。 我們不在乎值，您可以將任何想要的值傳遞給它。 我Nothing 。 如果使用.Add方法，則如果列表中包含重復的條目，則字典將引發錯誤。

假設您實現了一些功能，可以將文件作為工作表加載並返回該工作表。

Dim valueSheet As Worksheet
Set valueSheet = LoadSomeFileTypeAsWorksheet("some file path")

Dim valueRange As Range
Set valueRange = valueSheet.??? 'column A or whatever

Dim MyDictAsSet As Dictionary
Set MyDictAsSet = LoadRedValueSet(valueRange)

Set MyPlage = Range("A1:R1000")
For Each Cell In MyPlage
    If MyDictAsSet.Exists(Cell.Value) Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If
Next

Answer 2

您可以通過多種方式執行此操作，但這是我的方法。 Application.WorksheetFunction.<function name>可用於評估VBA中的工作表功能。 這意味着我們可以使用它來運行Match函數。 為了簡單起見，讓我們假設要匹配的值在名為Sheet2的工作表的A列中（在同一工作簿中）。

Dim MyPlage As Range, Cell As Range
Dim result as Variant
Set MyPlage = Range("A1:R1000") '<~~ NOTE: Sheets("<SheetName>").Range("A1:R1000") would be better

For Each Cell in MyPlage
    result = Application.WorksheetFunction.Match(Cell.Value, Sheets("Sheet2").Range("A:A"), 0)
    If Not IsError(result) Then
        Rows(Cell.Row).Interior.ColorIndex = 3
    End If
Next Cell

我們只需要知道WorksheetFunction.Match函數是否返回錯誤：如果沒有返回，則Sheet2的A列中存在Cell.Value，我們將行塗成紅色。

Answer 3

按以下順序將您的顏色值+索引數據粘貼到名為“ Colors”的新工作表中；

Value   ColorIndex
A       1
B       2
C       3
D       4
E       5

並使用以下代碼更新您的方法，並根據您的數據更新范圍；

Sub SetColors()

    ' DataCells: The cells that's going to be checked against the color values
    Set DataCells = Range("A1:A15") ' Update this value according to your data cell range

    ' ColorValueCells: The cells that contain the values to be colored
    Set ColorValueCells = Sheets("Colors").Range("A2:A6") ' Update this value according to your color value + index range

    ' Loop through data cells
    For Each DataCell In DataCells

        ' Loop through color value cells
        For Each ColorValueCell In ColorValueCells

            ' Search for a match
            If DataCell.Value = ColorValueCell.Value Then

                ' If there is a match, find the color index
                Set ColorIndexCell = Sheets("Colors").Range("B" & ColorValueCell.Row)

                ' Set data cell's background color with the color index
                DataCell.Interior.ColorIndex = ColorIndexCell.Value

            End If
        Next
    Next
End Sub