Excel VBAカラーセルの値が配列の値と等しい場合

Question

例を検索し、さまざまなコードを試しましたが、機能しません。 同じブック（2つは「PASTfromFeb2017」と呼ばれるもの）で2枚を通過するマクロを作成したいと思います。各シートで、値が配列にリストされているものと等しいかどうかチェックしたいと思います。値が等しい場合は、セル全体が色で塗りつぶされます（例：赤）。

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ループを交換し、コラム「C」で可能なセルがarrSht配列内の値のいずれかと等しい場合は見つけることApplication.Matchを使用することができます。

コード

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