VBA - 2つの列を比較するためのExcel

Question

私は同じExcelファイルの2枚を比較する1つのVBAを作成しました。シートAのデータが正確でない場合、その行の色が赤に変わります。また、色が変更された場合にはフィルタを適用しました。

問題は、適切な方法で動作していないことです。私のデータが同じである場合のように、それはまた、フィルタを適用しています。

Sub Validate_Metadata() 
Dim myRng As Range 
Dim lastCell As Long 
Dim flag As Boolean 

    'Get the last row 
    Dim lastRow As Integer 
    lastRow = ActiveSheet.UsedRange.Rows.Count 

    'Debug.Print "Last Row is " & lastRow 

    Dim c As Range 
    Dim d As Range 

    Application.ScreenUpdating = False 



    For Each c In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells 
     For Each d In Worksheets("Sheet2").Range("A2:A" & lastRow).Cells 
      c.Interior.Color = vbRed 
      flag = False 
      If (InStr(1, d, c, 1) > 0) Then 
       c.Interior.Color = vbWhite 
       Exit For 
      End If 
     Next 
    Next 

    If (flag <> True) Then 

     ActiveSheet.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=RGB(255, 0 _ 
     , 0), Operator:=xlFilterCellColor 
    End If 

Application.ScreenUpdating = True 
End Sub 

以下の私のコードを参照してくださいおかげ

Answer 1

はこれを試してみてください：

Sub Validate_Metadata() 
    Dim myRng As Range 
    Dim lastCell As Long 
    Dim flag As Boolean 

    'Get the last row 
    Dim lastRow As Integer 
    Dim localFlag As Boolean 
    lastRow = ActiveSheet.UsedRange.Rows.Count 

    'Debug.Print "Last Row is " & lastRow 

    Dim c As Range 
    Dim d As Range 

    Application.ScreenUpdating = False 


    flag = True 
    For Each c In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells 
    localFlag = False 
    For Each d In Worksheets("Sheet2").Range("A2:A" & lastRow).Cells 
     c.Interior.Color = vbRed 
     If (InStr(1, d, c, 1) > 0) Then 
      c.Interior.Color = vbWhite 
      localFlag = True 
      Exit For 
     End If 
    Next 
    flag = flag And localFlag 
    Next 

    If (flag <> True) Then 

    ActiveSheet.Range("A1:A" & lastRow).AutoFilter Field:=1, 
    Criteria1:=RGB(255, 0 _ 
    , 0), Operator:=xlFilterCellColor 
    End If 

    Application.ScreenUpdating = True 
End Sub 

Answer 2

あなたが最初赤に細胞の内部の色を変更して状態をチェックされています。一致した場合は、再度セルの色をに変更します。です。私はこれが良いアプローチではないと思います。代わりに、最初に条件を確認し、一致がない場合にのみ色を変更します。

このような何か：

Sub Validate_Metadata() 
    Dim myRng As Range 
    Dim lastCell As Long 
    Dim flag As Boolean, found As Boolean 'new boolean variable declared 
    'Get the last row 
    Dim lastRow As Integer 
    lastRow = ActiveSheet.UsedRange.Rows.Count 
    Dim c As Range 
    Dim d As Range 
    Application.ScreenUpdating = False 
    For Each c In Worksheets("Sheet11").Range("A2:A" & lastRow).Cells 
     found = False 'set flag here for cell 
     For Each d In Worksheets("Sheet12").Range("A2:A" & lastRow).Cells 
      If (InStr(1, d, c, 1) > 0) Then 
       c.Interior.Color = vbWhite 
       found = True 
       Exit For 
      End If 
     Next d 
     If Not found Then 'if cell do not match change the color 
      c.Interior.Color = vbRed 
      If Not flag Then flag = True 'change filter flag to true just once 
     End If 
    Next c 
    If flag Then 'check for filter flag 
     ActiveSheet.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=RGB(255, 0 _ 
     , 0), Operator:=xlFilterCellColor 
    End If 
    Application.ScreenUpdating = True 
End Sub