如果满足条件，需要突出显示数组。但是如何？答案

【问题标题】：Need to highlight array if condition is met. But How?如果满足条件，需要突出显示数组。但是如何？
【发布时间】：2021-07-14 00:45:13
【问题描述】：

我有一个单元格，其中包含要过滤特定文本（预过滤）的数据。只想用符合特殊单元格数组的单元格值突出显示特定单元格。

Sub EmailDataPrep()

    Dim r As Range 
    Dim lastrow As Long 
    Dim MyArray() As Variant
    
    MyArray = Range("F3:F200")
    
    currow = Sheets("Current_Emails").Range("F3")
    
    lastrow = Cells(Rows.Count, "F3").End(xlUp).row
    
    For Each r In Range("F" & currow & "F" & lastrow)
    
        If r.Value = MyArray Then
    
            r.Interior.Color = "Green"
    
        End If
  
    Next r

End Sub

【问题讨论】：

你的代码做错了什么？
很多代码中的问题。 MyArray = Range("F3.F200") 将失败，应该是 : 而不是 . currow = Range("F3") 隐式引用 ActiveSheet。 .MyArray 没有意义，为什么是句号？ Cells.Interior.Color = "Green" 是所有单元格。缺少End If。您不能将单个单元格的值与数组进行比较。您需要一个循环或Application.Match，与数组一起使用时会很慢。
它与我们的 r 一样给出错误。
我现在修改代码如下。
If r.Value = MyArray Then 无效。您不能像这样直接将单个单元格与数组进行比较。

标签： arrays vba foreach formatting range

【解决方案1】：

突出显示匹配的单元格

调整常量部分中的值。
假设工作簿中有两个工作表包含此代码。
Source Column Range 的值将被写入数组。循环通过Destination (Column) Range 的单元格，将尝试将每个单元格值与数组进行匹配。如果找到匹配项，则对当前单元格的引用将合并到 Combined Range 中。最后，Combined Range 的所有（匹配）单元格都将突出显示。

Option Explicit

Sub EmailDataPrep()

    ' Source
    Const sName As String = "Sheet1" '***
    Const sFirst As String = "F3"
    ' Destination
    Const dName As String = "Current_Emails"
    Const dFirst As String = "F3"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Define Source Range and write its values to Data Array.
    Dim srg As Range
    With wb.Worksheets(sName).Range(sFirst)
        Dim sCell As Range
        Set sCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If sCell Is Nothing Then Exit Sub
        Set srg = .Resize(sCell.Row - .Row + 1)
    End With
    Dim Data As Variant: Data = srg.Value
    
    ' Define Destination Range.
    Dim drg As Range
    With wb.Worksheets(dName).Range(dFirst)
        Dim dCell As Range
        Set dCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If dCell Is Nothing Then Exit Sub
        Set drg = .Resize(dCell.Row - .Row + 1)
    End With
    
    ' Loop through cells of Destination Range and attempt to find
    ' a match in Data Array. If found, combine its reference to the matching cell
    ' in the Combined Range.
    Dim crg As Range
    For Each dCell In drg.Cells
        If IsNumeric(Application.Match(dCell.Value, Data, 0)) Then
            If crg Is Nothing Then
                Set crg = dCell
            Else
                Set crg = Union(crg, dCell)
            End If
        End If
    Next dCell
    
    ' Highlight matching cells (cells of the Combined Range) in one go.
    If Not crg Is Nothing Then
        crg.Interior.Color = vbGreen
    End If
    
End Sub

【讨论】：