VBA基于值是否在文本列表中的条件格式单元格
我有这个代码：
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 我们可以find任何有A，B，C，D，E作为值的单元格，如果是这样的话，整个行就会变成红色。
基本上，我有更多的价值，我想查找。 我有他们存储在另一个Excel文件（可以很容易地在一个文本文件）。 我怎么能参考他们？ 即，如果单元格值在文本列表中，请执行此操作。
听起来你想要一个包含唯一值的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对象。 但是，它确实提供了一个可以像Set一样被滥用的Dictionary对象。 您将需要引用脚本运行时库来首先使用它 。 用法与上面所述完全相同。 但首先我们需要定义LoadRedValueSet()
让我们假设你可以在Excel工作表中加载保存这些值的任何文件。 我不会解释如何在Excel中打开各种文件types，因为有很多答案详细说明了我所能做的。 但是，一旦你有你的范围值添加到集合，我们可以将它们添加到字典。
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是映射具有键 – 值对的对象。 钥匙实际上是一套，这是我们想要的。 我们不关心价值观，你可以通过任何你想要的。 我用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
有很多方法可以做到这一点，但这是我的方法。 Application.WorksheetFunction.<function name>可用于评估VBA中的工作表函数。 这意味着我们可以使用它来运行匹配function。 为了一个简单的例子，让我们假设你的值匹配在一个名为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列中，并且我们将该行的颜色设为红色。
将您的颜色值+索引数据按以下顺序粘贴到名为“颜色”的新工作表中;
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