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 datastructure包含唯一值，并且可以使用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那样被滥用。 You will need to reference the Scripting Runtime Library to use it first through。用法完全如上所述。但首先我们需要定义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

Dictionary是映射具有key-＆gt;值对的对象。关键词实际上是一个集合，这就是我们想要的。我们不关心价值观，你可以通过任何你想要的东西。我用了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函数是否返回错误：如果它没有，那么Cell.Value出现在Sheet2的A列中，我们将该行着色为红色。

Answer 3

将您的颜色值+索引数据粘贴到名为＆＃34; Colors＆＃34;按以下顺序;

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

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

3 个答案: