エクセルで特定の行を削除（特定文字が複数）

質問

http://okwave.jp/qa/q2692757.html
に後述のマクロが紹介されていますが、
特定の文字が、"XXX"以外に、複数ある場合はどのようにすればよいか教えてください。
"XXX" and/or "YYY" and/or "ZZZ" の例で教えていただけませんか。

Sub DelLines()
　　Dim R As Range
　　Do
　　　　Set R = ActiveSheet.Range("B:B").Find(What:="XXX", LookAt:=xlPart)
　　　　If R Is Nothing Then Exit Sub
　　　　R.EntireRow.Delete
　　Loop
End Sub

回答No.1

noname#203218 · ベストアンサー

Sub DelLines()
Dim R As Range
Dim fword(3) As String
Dim i As Integer

fword(1) = "XXX"
fword(2) = "YYY"
fword(3) = "ZZZ"

For i = 1 To 3
Do
Set R = ActiveSheet.Range("B:B").Find(fword(i), LookAt:=xlWhole)
If R Is Nothing Then Exit Do
R.EntireRow.Delete
Loop
Next
End Sub

検索文字を増やしたい場合は下記数値を増加させて下さい。
Dim fword(3) As Stringの（）内数値
fword(3) = "ZZZ"以降に追加ワードを追加
For i = 1 To 3の数値を増加

お礼

補足説明を含め有難うございました。
文字列を「含む」とした場合も、アスタリスクを加えることで対応できますね。

fword(1) = "*XXX*"
fword(2) = "*YYY*"
fword(3) = "*ZZZ*"

回答No.2

tom04

こんばんは！
せっかくコードをお考えですが、↓のような感じではどうでしょうか？

Sub Sample1()
Dim i As Long, j As Long, k As Long, myArray

myArray = Array("XXX", "YYY", "ZZZ")
Application.ScreenUpdating = False
Rows(1).Insert
Range("B1") = "B列"
On Error Resume Next '←念のため
For k = 0 To UBound(myArray)
Range("B1").AutoFilter field:=1, Criteria1:="*" & myArray(k) & "*"
i = WorksheetFunction.Match(myArray(k), Range("B:B"), False)
j = Cells(Rows.Count, 2).End(xlUp).Row
If j > 1 Then
Rows(i & ":" & j).Delete
End If
Next k
ActiveSheet.AutoFilterMode = False
Rows(1).Delete
Application.ScreenUpdating = True
End Sub

※　オートフィルタでXXX・YYY・ZZZを含むものでフィルタをかけ、その行を削除しています。
尚、オートフィルタのOR条件は2つしか設定できませんので、敢えてArrayを使っています。m(_ _)m

お礼

有難うございます。
思った結果が実行できました。
オートフィルタのマクロ自動記録を使うなどして動きを確認したいと思います。