当Excel VBA颜色单元格的值等于数组中的值时

我search的例子，并尝试了许多不同的代码，但它不工作。 我想创build一个macros，在同一个工作簿（一个名为“提交”，第二个名为“PASTfromFeb2017”）中通过两张。 在每张表中，我想检查一下值是否等于数组中列出的值。 如果数值相等，则整个单元应填充颜色（例如，红色）。

这是我到目前为止（但它不工作）…

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

您可以replace您的For循环，并使用Application.Match来查找列“C”中的可能的单元格是否等于arrSht数组内的值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