当它的值等于阵列中的值时，Excel VBA颜色单元格

Question

我已经搜索了示例并尝试了许多不同的代码，但是它不起作用。我想创建一个宏，该宏通过同一工作簿中的2张(一个称为"提交"，第二个称为" Pastfromfeb2017"(。在每个表中，我想检查值是否等于数组中列出的值。如果值相等，则应将整个单元格填充颜色(对于Ex。Red(。

这是我到目前为止所拥有的(但它不起作用(...

Option Explicit
Sub colorCell()
Application.ScreenUpdating = False
Dim wbk As Workbook
Dim SubmissionWkst As Worksheet
Dim PASTfromFeb2017Wkst As Worksheet
Dim lastRow As Long
Dim lRow As Long
Dim sheetName As String
Dim arrSht() As Variant
Dim cell As Range
Dim k As Long
Dim i As Integer

arrSht = Array("MK-3475", "MK-8415", "MK-0431", "MK-0517", "MK-8931", "MK-8835", "V-501", "V-503", "V-110", "MK-4305", "V-211", "MK-5172")
For k = LBound(arrSht) To UBound(arrSht)
    ThisWorkbook.Worksheets("Submission").Activate
    With ActiveSheet
        For lRow = 2 To lastRow
            If Cells(lRow, "C").Value Like arrSht.Value Then
            Cells(lRow, "C").Interior.ColorIndex = 3
            End If
        Next i
   End With
Next k
For k = LBound(arrSht) To UBound(arrSht)
    ThisWorkbook.Worksheets("PASTfromFeb2017").Activate
    With ActiveSheet
        For lRow = 2 To lastRow
            If Cells(lRow, "C").Value Like arrSht.Value Then
            Range(Cells(lRow, "C"), Cells(lRow, "C")).Interior.ColorIndex = 3
            End If
        Next i
   End With
Next k
Application.ScreenUpdating = True
End Sub

Answer 1

您可以替换For循环，并使用Application.Match查找" C"列中可能的单元格等于arrSht数组中的一个值之一。

代码

Option Explicit
Sub colorCell()
Dim wbk As Workbook
Dim SubmissionWkst As Worksheet
Dim PASTfromFeb2017Wkst As Worksheet
Dim ws As Worksheet
Dim lastRow As Long
Dim arrSht() As Variant
Dim i As Long
Application.ScreenUpdating = False
arrSht = Array("MK-3475", "MK-8415", "MK-0431", "MK-0517", "MK-8931", "MK-8835", "V-501", "V-503", "V-110", "MK-4305", "V-211", "MK-5172")
For Each ws In ThisWorkbook.Sheets
    With ws
        ' run the code only if sheet's name equal one of the tow in the If
        If .Name = "Submission" Or .Name = "PASTfromFeb2017" Then
            lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
            For i = 2 To lastRow
                ' check that there is a match with one of the values inside arrSht array
                If Not IsError(Application.Match(.Range("C" & i).Value, arrSht, 0)) Then
                    .Range("C" & i).Interior.ColorIndex = 3
                End If
            Next i
        End If
    End With
Next ws
Application.ScreenUpdating = True
End Sub

Answer 2

尝试一下。它使用的.Find有效：

Sub ColorCell()
    Dim rng1 As Range, rng2 As Range
    Application.ScreenUpdating = False
    Set rng1 = Worksheets("Submission").Range("C2:C" & Worksheets("Submission").Range("C2").End(xlDown).Row)
    Set rng2 = Worksheets("PASTfromFeb2017").Range("C2:C" & Worksheets("PASTfromFeb2017").Range("C2").End(xlDown).Row)
    FindMatches rng1
    FindMatches rng2
    Application.ScreenUpdating = True
End Sub
Sub FindMatches(rng As Range)
    Dim arrSht() As Variant, c As Range, n As Integer
    arrSht = Array("MK-3475", "MK-8415", "MK-0431", "MK-0517", "MK-8931", "MK-8835", "V-501", "V-503", "V-110", "MK-4305", "V-211", "MK-5172")
    For n = LBound(arrSht) To UBound(arrSht)
        With rng
            Set c = .Find(arrSht(n), LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    c.Interior.ColorIndex = 3
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next n
End Sub