シート1のセルがシート2のセルと一致する場合、VBA - 行を削除しますか？

Question

シート1とシート2の2つのワークシートがあります。

シート1では、ユーザーがセルB21、B26、I21、I26、P21、P26に値を入力できるようにフォームを作成しました。

送信をクリックすると、次の利用可能な行の列A、B、C、D、E、Fのシート2にデータが挿入されます。

実行したマクロを作成しようとしていますが、値がsheet1の値と一致するシート2の行が削除されます。

私はIF文を使って単純なままにしていますが、これは私に型の不一致のエラーを与えます。

Sub QuickCull() 

If Sheets(1).Range("B21").Value = Sheets(2).Range("A:A").Value And _ 
    Sheets(1).Range("B26").Value = Sheets(2).Range("B:B").Value And _ 
    Sheets(1).Range("P21").Value = Sheets(2).Range("C:C").Value And _ 
    Sheets(1).Range("I21").Value = Sheets(2).Range("D:D").Value And _ 
    Sheets(1).Range("I26").Value = Sheets(2).Range("E:E").Value And _ 
    Sheets(1).Range("P26").Value = Sheets(2).Range("F:F").Value Then 

    Rows(ActiveCell.Row).EntireRow.Delete 
End If 

End Sub 

私がどこに間違っているのか見せてもらえますか？

Answer 1

最初に条件が満たされているかどうかを確認する必要があるため、Match関数を使用して、Sheets(2)の列A全体の範囲（ "B21"）の値を検索します。一致した場合は、その結果（行番号を表すRowMatch）を使用します。

次に、他のすべてのIfがRowMatchの一致する値を持つことを確認する必要があります。Sheets(2)です。そうであれば、Sheets(2)でその行を削除できます。

Option Explicit 

Sub QuickCull() 

Dim RowMatch As Long 

With Sheets(2) 
    If Not IsError(Application.Match(Sheets(1).Range("B21").Value, .Range("A:A"), 0)) Then 
     RowMatch = Application.Match(Sheets(1).Range("B21").Value, .Range("A:A"), 0) 

     If Sheets(1).Range("B26").Value = .Range("B" & RowMatch).Value And _ 
      Sheets(1).Range("P21").Value = .Range("C" & RowMatch).Value And _ 
      Sheets(1).Range("I21").Value = .Range("D" & RowMatch).Value And _ 
      Sheets(1).Range("I26").Value = .Range("E" & RowMatch).Value And _ 
      Sheets(1).Range("P26").Value = .Range("F" & RowMatch).Value Then 

      .Rows(RowMatch).Delete 
     End If 

    End If 
End With 

End Sub