参照元を削除したい

質問

参照元シートのA列で参照先のA列を検索し、参照先に参照元の内容があれば参照元を行削除しようとしています。
現在下記ソースの状態ですが、参照元を削除するとSETで保持しているアドレスと実際削除するアドレスが違ってしまうようで正しく動作しません。
参照元と参照先の関係を逆にすれば意図することが実現できますが、データ数の関係でそれは考えていません。（参照元が500未満、参照先が数万）
どうすれば参照元が削除可能になるでしょうか。

Sub DeleteRow()

Dim 参照元 As Range
Dim 検索CD As Variant
Dim 最終行 As Integer
Dim S As Variant

Set 参照元 = Sheets("参照元").Range("A2:A" & Sheets("参照元").Range("A2").End(xlDown).Row)
最終行 = Sheets("参照先").Range("A3").End(xlDown).Row

For Each S In 参照元
Set 検索CD = Sheets("参照先").Range("A4:A" & 最終行).Find(S)
If Not 検索CD Is Nothing Then
S.EntireRow.Delete
End If
Next S

End Sub

回答No.3

K Kazz（@JazzCorp） · ベストアンサー

Option Explicit
Sub DeleteRow()
Dim 参照元 As Range
Dim 検索CD As Variant
Dim 最終行 As Long
Dim nn As Long
Dim S As Variant
Set 参照元 = Sheets("参照元").Range("A2:A" & Sheets("参照元").Range("A" & Rows.Count).End(xlUp).Row)
最終行 = Sheets("参照先").Range("A" & Rows.Count).End(xlUp).Row
'For Each S In 参照元
For nn = Sheets("参照元").Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
S = Sheets("参照元").Cells(nn, "A").Value
Set 検索CD = Sheets("参照先").Range("A4:A" & 最終行).Find(S)
If Not 検索CD Is Nothing Then
Sheets("参照元").Cells(nn, "A").EntireRow.Delete
End If
Next
End Sub

回答No.2

keithin

＞参照元を行削除しようとしています

一気に抽出し，一気に削除します。

sub macro1()
　dim buf1 as variant
　dim moto as range
　dim saki as range

　buf1 = worksheets("参照先").range("A1").value
　worksheets("参照先").range("A1").value = worksheets("参照元").range("A1").value
　set moto = worksheets("参照元").range("A1:A" & worksheets("参照元").range("A65536").end(xlup).row)
　set saki = worksheets("参照先").range("A1:A" & worksheets("参照先").range("A65536").end(xlup).row)

　on error resume next
　moto.advancedfilter action:=xlfilterinplace, criteriarange:=saki, unique:=false
　moto.offset(1).specialcells(xlcelltypevisible).entirerow.delete shift:=xlshiftup
　moto.parent.showalldata

　worksheets("参照先").range("A1") = buf1
end sub

回答No.1

chie65535

＞どうすれば参照元が削除可能になるでしょうか。

１件削除したら、削除直後にExit Subして、関数を呼ぶ所からやり直して下さい。

「行削除したら、すべて頭からやり直し」が必要です。

さもなければ（最初からやり直しが嫌ならば）「下から順に、逆順に削除」していく必要があります。