| 
    
     |  | ▼たつ さん: 
 興味がわいたので作ってみました。
 削除すべき行の3列目に"○"印を付けるようにしています。
 考え方はこれであっていますか?
 合っていればEr内の整列と、下の行からの削除というように
 改造する方法はいかがでしょうか。
 
 Option Explicit
 
 Sub test()
 Dim i As Long, j As Long, k As Long
 Dim r2 As Long, r1 As Long
 
 Dim dat As Variant, Er As Variant
 
 '削除対象読み込み
 With Worksheets("Sheet2")
 r2 = .Range("A" & Rows.Count).End(xlUp).Row
 ReDim dat(1 To r2)
 For i = 1 To r2
 dat(i) = .Cells(i, 1).Value
 Next i
 End With
 With Worksheets("Sheet1")
 r1 = .Range("A" & Rows.Count).End(xlUp).Row
 ReDim Er(1 To 1)
 Do
 k = 0
 For i = 1 To r1
 If InStr(vbTab & Join(dat, vbTab) & vbTab, _
 vbTab & .Cells(i, 1).Value & vbTab) > 0 Then
 If InStr(vbTab & Join(Er, vbTab) & vbTab, _
 vbTab & i & vbTab) = 0 Then
 If Er(UBound(Er)) <> "" Then
 ReDim Preserve Er(1 To UBound(Er) + 1)
 End If
 Er(UBound(Er)) = i
 End If
 For j = 1 To UBound(dat)
 If InStr(vbTab & Join(dat, vbTab) & vbTab, _
 vbTab & .Cells(i, 2).Value & vbTab) = 0 Then
 If dat(UBound(dat)) <> "" Then
 ReDim Preserve dat(1 To UBound(dat) + 1)
 End If
 dat(UBound(dat)) = .Cells(i, 2).Value
 k = 1
 End If
 Next j
 Else
 End If
 Next i
 Loop While k = 1
 For i = 1 To UBound(Er)
 .Cells(Er(i), 3).Value = "○"
 Next i
 End With
 End Sub
 
 |  |