| 
    
     |  | ▼gin さん: こんにちは。
 1行目はタイトル行として(AutoFilter使用のため)
 又使用していない列があるものとして(作業列として使用)
 下記の方法ではどうでしょう。
 
 Sub TESTc()
 Dim v1 As Variant
 Dim v2 As Variant
 Dim i  As Long
 Dim j  As Long
 Dim Dic As Object
 v1 = Worksheets("Sheet2").Range("A1").CurrentRegion.Resize(, 1).Value
 v2 = Worksheets("Sheet1").Range("A1").CurrentRegion.Resize(, 1).Value
 ’Sheet2をディクショナリに登録
 Set Dic = CreateObject("Scripting.Dictionary")
 For i = 1 To UBound(v1)
 Dic(v1(i, 1)) = Empty
 Next
 ' 存在チェック
 For i = 1 To UBound(v2)
 If Dic.Exists(v2(i, 1)) Then
 ' 合ったら "DeleteRow" に置き換え(Sheet1の値と重複しなければなんでもOK)
 v2(i, 1) = "DeleteRow"
 End If
 Next
 With Worksheets("Sheet1")
 .AutoFilterMode = False
 ' 空いている列(作業列)にチェックした値を貼付け
 .Range("D1").Resize(UBound(v2)).Value = v2
 ' AutoFilterをかける
 With .Range("D1").CurrentRegion.Resize(, 1)
 .AutoFilter Field:=1, Criteria1:="DeleteRow"
 ' 可視行を削除
 .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 End With
 .AutoFilterMode = False
 .Columns(4).ClearContents
 End With
 End Sub
 
 |  |