基于值是否在文本列表中的VBA条件格式单元格

Question

I have this code:

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

THis find any cells that have either A, B, C, D, E as the value and then colours the entire row red if so.

Basically, I have hundreds of more values that I want to lookup. I have them stored in another excel file (could just as easily be in a text file). How could I reference them? ie, if cell value is in this list of text, do this.

Answer 1

Sounds like you want a Set datastructure that contains unique values and you can use an Exist method on it.

For example your desired usage is this.

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

Well too bad Set is a reserved keyword and VBA does not provide a Set object. However, it does provide a Dictionary object which can be abused like a Set would be. You will need to reference the Scripting Runtime Library to use it first through . The usage would be exactly as stated as above. But first we need to define LoadRedValueSet()

Lets assume that you are able to load whatever file you save these values as in as an Excel worksheet. I will not be explaining how to open various file types in Excel as there are many answers detailing that in more detail than I can. But once you have your range of values to add to the set we can add them to the dictionary.

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

Dictionary are mapping objects that have key->value pairs. The key's are effectively a set, which is what we want. We don't care about the values and you can pass whatever you want to it. I used Nothing . If you use the .Add method the dictionary will throw an error if your list contains duplicate entries.

Assuming you have implemented some function that loads your file as a worksheet and returns that worksheet.

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

There are quite a few ways you could possibly do this but here's my approach. Application.WorksheetFunction.<function name> can be used to evaluate worksheet functions within VBA. This means we can use it to run a Match function. For the sake of a simple example let's assume your values to match are in Column A of a worksheet called Sheet2 (in the same workbook).

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

We only need to know whether or not the WorksheetFunction.Match function returned an error: If it didn't then Cell.Value was present in Column A of Sheet2 and we color the row red.

Answer 3

Paste your color value + index data to a new sheet called "Colors" in the following order;

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

And update your method with the following code and update the range based your data;

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