特定文字列を含む行を削除するマクロ

質問

すみませんどなたか教えてください。

エクセルで商品の在庫管理をしておりまして、AP列に製品メーカー名が入っているのですが、
いくつかの（数十個）メーカーを省き削除したく思い、以下のようなマクロをググって作ってみましたが、
上手く動きませんでした。　1つのメーカーだけ記載した場合はうまく動きました。

やりたいことは1つのマクロの中に、数十個のメーカー名を記入しておき、そのメーカーを全件
検索して、AP列に文字列が含まれる場合は、その行を削除したいです。
宜しくお願い致します。

～～～～～～
Sub DelLines1()
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete
Loop
Sub DelLines2()
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete
Loop
Sub DelLines3()
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart)
If R Is Nothing Then Exit Sub
R.EntireRow.Delete
Loop
End Sub

回答No.3

keithin · ベストアンサー

ん？
＞構文が分かっておらず申し訳ありません、もう少し勉強してみます。

その通りですね。

再掲：
＞そもそもsub と end subは一対一でなければなりません

あなたの修正マクロ：
Sub DelLines1()　’←これを実行したら
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
End Sub　’←ここで終了してオシマイ。

Sub DelLines2()　’←ここからは，別のマクロとして新たに実行しなきゃ
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
End Sub　’２つ目ここまで

Sub DelLines3()　’←これも３つ目のマクロ
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
End Sub　’３つ目はここまで

アナタが意図したマクロ全体をスルーで実行するには：
Sub DelLines1()　’←これから開始して
　Dim R As Range

　Do
　　Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart)
　　If R Is Nothing Then Exit Do
　　R.EntireRow.Delete
　Loop

　Do
　　Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart)
　　If R Is Nothing Then Exit Do
　　R.EntireRow.Delete
　Loop

　Do
　　Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart)
　　If R Is Nothing Then Exit Do
　　R.EntireRow.Delete
　Loop
End Sub　’ここまでをヒトカタマリとして作成する

お礼

私が分かっておりませんでした。
お教え頂きました記述で実行することができました。
度々の回答本当にありがとうございます。

回答No.2

keithin

マクロの構成がまるで間違ってましたね。
そもそもsub と end subは一対一でなければなりません。

例：
sub macro1()
　dim r as range
　dim x as variant

　for each x in array("softbank", "docomo", "au")
　　do
　　　set r = range("AP:AP").find(what:=x, lookat:=xlpart)
　　　if r is nothing then exit do
　　　r.entirerow.delete
　　loop
　next
end sub

お礼

回答ありがとうございます。
上記方法で出来ました。
構文が分かっておらず申し訳ありません、もう少し勉強してみます。

回答No.1

keithin

誤：
If R Is Nothing Then Exit Sub

正：
If R Is Nothing Then Exit do

漏れなく修正します。

お礼

回答ありがとうございます。修正して実行したのですが、end subを入れるようメッセージが出力されて、挿入して実行したのですが、1つ目しか削除されませんでした。
Sub DelLines1()
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="au", LookAt:=xlPart)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
End Sub
Sub DelLines2()
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="docomo", LookAt:=xlPart)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
End Sub
Sub DelLines3()
Dim R As Range
Do
Set R = ActiveSheet.Range("AP:AP").Find(What:="softbank", LookAt:=xlPart)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
End Sub