2つのシートを比較し、ない行を削除

Question

下記のような２つのシートがあり、番号がふられています。
番号「３」のようにシートAにあってシートBにない場合、
シートAの番号「３」の行をすべて削除したいのですが、コードの書き方がわかりません。
お手数ですが、コードの記載方法の理解もしたく、ご教授よろしくお願いいたします。

シートA

製品	名前	番号
りんご	田中	１
	鈴木	２
りんご	井上	３
	４
みかん	井上	５

シート２

製品	名前	番号
りんご	田中	１
	鈴木	２
	４
みかん	井上	５

Answer 1

Sub sample()
    Dim sheetA As Worksheet, sheetB As Worksheet
    Set sheetA = Sheets("シートA")
    Set sheetB = Sheets("シートB")
    
    Dim lastRow
    lastRow = sheetA.Range("C" & sheetA.Rows.Count).End(xlUp).Row

    Dim i
    For i = lastRow To 2 Step -1
        If WorksheetFunction.CountIf(sheetB.Range("C:C"), sheetA.Range("C" & i)) = 0 Then sheetA.Rows(i).Delete
    Next
End Sub

Comments

[minako_tera]

返信が遅くなり申し訳ございません。初心者でもわかりやすい回答ありがとうございます。

Answer 2

一例です。ご参考に。

Public Sub sample()
    Dim r1 As Range '削除対象セル範囲
    With Worksheets("シートA")
        Set r1 = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
    End With
    Dim r2 As Range '検索対象セル範囲
    With Worksheets("シート2")
        Set r2 = .Range(.Cells(2, 3), .Cells(.Rows.Count, 3).End(xlUp))
    End With

    Dim c As Range, v As Variant
    Dim delRows As Range '削除行を格納する
    For Each c In r1
        v = Application.Match(c.Value, r2, 0) '完全一致で検索
        If IsError(v) Then '見つからなければ
            If delRows Is Nothing Then
                Set delRows = c.EntireRow
            Else
                Set delRows = Union(delRows, c.EntireRow)
            End If
        End If
    Next
    If Not delRows Is Nothing Then delRows.Delete
End Sub

Comments

[minako_tera]

どうもありがとうございます。大変助かります。
お時間かかりますが、確認させていただきます。

[minako_tera]

確認が遅くなり申し訳ございません。無事できました。ご丁寧にありがとうございました。

Answer 3

つたないですが以下のようなコードはいかがでしょう？

コード
Dim LASTROW1 As Long
Dim LASTROW2 As Long

LASTROW1 = Worksheets(1).Cells(Rows.Count, 3).End(xlUp).Row
LASTROW2 = Worksheets(2).Cells(Rows.Count, 3).End(xlUp).Row


Dim k As Long
Dim kk As Long
Dim i As Long

Dim STR1 As String
Dim STR2() As String

ReDim STR2(LASTROW2) As String

For i = 2 To LASTROW2
    STR2(i) = Worksheets(2).Cells(i, 3).Value
Next i


Dim TF As Boolean

For k = LASTROW1 To 2 Step -1
    STR1 = Worksheets(1).Cells(k, 3).Value
    TF = False
    
    For kk = 2 To LASTROW2
        If STR1 = STR2(kk) Then
            TF = True
        End If
    Next kk
    
    If TF = False Then
         Worksheets(1).Rows(k).Delete
    End If
Next k

Comments

[minako_tera]

ご連絡ありがとうございます。
理解するまでに少し時間がかかりそうですので、まずはご連絡させていただきました。
よろしくお願いいたします。

[minako_tera]

確認が遅くなり申し訳ございません。無事できました。ご丁寧にありがとうございました。