ExcelVBA：複数の文字列を検索し、行ごと削除したい

質問

VBA初心者です。お教え下さい。

タイトル通り複数の文字列（例えば「aaa」）を検索し、行ごと削除したいのですが、以下のコードでは、「aaa」を検索せず、一番上の行から削除されてしまいます。。。

どこがどう間違ってるかわかりません。
どうかよろしくお願いします。

Private Sub CommandButton1_Click()

Dim StrkeyWord(10) As String '検索した文字列
Dim IngStartRow As Long '検索結果の行
Dim FoundCell As Range
Dim SearchArea As Range

Set SearchArea = ActiveSheet.UsedRange '検索対象範囲
Set FoundCell = SearchAea.Find(what:=trkeyWord) '検索実行

If FoundCell Is Nothing Then Exit Sub '検索文字列が含まれるセルがない場合中断

StrkeyWord(1) = "aaa"
StrkeyWord(2) = "bbb"
StrkeyWord(3) = "ccc"
StrkeyWord(4) = "ddd"
StrkeyWord(5) = "eee"
StrkeyWord(6) = "fff"
StrkeyWord(7) = "ggg"
StrkeyWord(8) = "hhh"
StrkeyWord(9) = "iii"
StrkeyWord(10) = "jjj"

For i = 1 To 10
Cells.Find(what:=StrkeyWord).Activate '検索

IngStarRow = ActiveCell.Row '検索結果の行からの削除の場合
Rows((Str(IngStartRow)&":"&Cstr(IngStartRow)),Delete Shift :=xlUp '削除

End Sub

回答No.1

Wendy02 · ベストアンサー

こんばんは。

この全体のコードの設計の発想は、初心者の方には無理です。ミスしそうな部分が一杯ありすぎます。アイデア自体は否定しませんが、初心者の方には、難しすぎます。

Private Sub CommandButton1_Click()
　　Dim StrkeyWord(10) As String
　　Dim FoundCell As Range
　　Dim FirstCell As String
　　Dim SearchArea As Range
　　Dim UArea As Range　'Union でまとめていく
　　Dim i As Long
　　Dim j As Long

　　Set SearchArea = ActiveSheet.UsedRange '検索対象範囲

　　StrkeyWord(1) = "aaa"
　　StrkeyWord(2) = "bbb"
　　StrkeyWord(3) = "ccc"
　　StrkeyWord(4) = "ddd"
　　StrkeyWord(5) = "eee"
　　StrkeyWord(6) = "fff"
　　StrkeyWord(7) = "ggg"
　　StrkeyWord(8) = "hhh"
　　StrkeyWord(9) = "iii"
　　StrkeyWord(10) = "jjj"

　　Application.ScreenUpdating = False
　　With SearchArea
　　　　For i = 1 To 10
　　　　　　Set FoundCell = .Find( _
　　　　　　What:=StrkeyWord(i), _
　　　　　　LookIn:=xlValues, _
　　　　　　LookAt:=xlWhole, _
　　　　　　SearchDirection:=xlNext)

　　　　　　If Not FoundCell Is Nothing Then
　　　　　　　　Set UArea = FoundCell
　　　　　　　　FirstCell = FoundCell.Address
　　　　　　　　Do
　　　　　　　　　　Set FoundCell = .FindNext(FoundCell)
　　　　　　　　　　If FirstCell = FoundCell.Address Then Exit Do
　　　　　　　　　　Set UArea = Union(UArea, FoundCell)
　　　　　　　　Loop Until FoundCell Is Nothing
　　　　　　End If
　　　　　　If Not UArea Is Nothing Then
　　　　　　　　For j = UArea.Areas.Count To 1 Step -1
　　　　　　　　　　UArea.Areas(j).EntireRow.Delete
　　　　　　　　Next
　　　　　　End If
　　　　　　Set UArea = Nothing
　　　　　　FirstCell = ""
　　　　Next i
　　End With
　　Application.ScreenUpdating = True
　　Set SearchArea = Nothing
End Sub

お礼

お礼が遅くなり申し訳ありません。

思い通りの動きが確認できました！
ありがとうございます！

初心者には、難しい・・・。
コードを見て実感しました。
もっと勉強していきたいと思います！

回答No.2

zap35

こんなアルゴリズムはどうでしょうか。
どうせ消す行ですから、まず検索文字がある行のA列に削除サインを書き込みます。その後で削除サインが立っている行だけ削除します。

Private Sub CommandButton1_Click()
Dim StrkeyWord(10) As String '検索した文字列
Dim FoundCell As Range
Dim FirstAdrs As String
Dim SearchArea As Range
Dim i As Integer
　Set SearchArea = ActiveSheet.UsedRange '検索対象範囲
　StrkeyWord(1) = "aaa"
　StrkeyWord(2) = "bbb"
　StrkeyWord(3) = "ccc"
　StrkeyWord(4) = "ddd"
　StrkeyWord(5) = "eee"
　StrkeyWord(6) = "fff"
　StrkeyWord(7) = "ggg"
　StrkeyWord(8) = "hhh"
　StrkeyWord(9) = "iii"
　StrkeyWord(10) = "jjj"

　For i = 1 To 10
　　Set FoundCell = SearchArea.Find(StrkeyWord(i), LookIn:=xlValues)
　　FirstAdrs = ""
　　If Not FoundCell Is Nothing Then
　　　FirstAdrs = FoundCell.Address
　　　Do
　　　　Cells(FoundCell.Row, 1).Value = "DEL"
　　　　Set FoundCell = SearchArea.FindNext(FoundCell)
　　　Loop Until FoundCell.Address = FirstAdrs
　　End If
　Next i

　For i = Range("A65536").End(xlUp).Row To 1 Step -1
　　If Cells(i, 1) = "DEL" Then
　　　Rows(i).Delete
　　End If
　Next i
End Sub

お礼

お礼が遅くなり申し訳ありません！

こうゆう考え方もあるのだ、と感心しました。
思いつきもしませんでした。。。

もっと勉強していきたいと思います！
ありがとうございました！！！