エクセルVBA、２重の検索方法について

質問

以前、回答していただいた記述で早速試してみたのですが・・・・。

実はキーワードの1つ目はデータの中に同じものがある場合があります。
1つ目で検索されたキーワードの同じものの中から、さらにキーワード２で最終的に絞り込みたいのです。
この記述だと、一番最初にキーワード１でひっかかったものしかキーワード２を検索しないので・・・。
Do　Loopを使うのだと思うのですが、どのように入れ込んでいくのかわかる方お願いします。

*この記述の内容は既にあるデータの中からInputBoxにキーワード１を入力し、データのC列を検索し１に合致したものの中から、さらにキーワード２で絞り込み、２つのキーワードが含まれた行全体を指定した場所にコピペするというものです。

Sub test02()
　　Dim Keyword, Keyword2, Fnd, Fnd2
　　'入力されたキーワードを変数Keywordに入れる
　　Keyword = InputBox("キーワードを入力してください")
　　Keyword2 = InputBox("キーワード2を入力してください")
　　'C列からキーワードを検索し、検索結果のセルをオブジェクト変数Fndにセットする
　　Set Fnd = Range("C:C").Find(Keyword) 'C列検索
　　If Not Fnd Is Nothing Then 'もし、C列にキーワードが見つかったら
　　　　Set Fnd2 = Range("E" & Fnd.Row).Resize(, 22).Find(Keyword2) '同行E-Z列検索
　　　　If Not Fnd2 Is Nothing Then 'もし、E～Z列にキーワードが見つかったら
　　　　　　Fnd.EntireRow.Copy 別の指定した行 'キーワードが見つかったセルを含む行全体を、[別の指定した行]にコピペ
　　　　　　Exit Sub '終了
　　　　End If
　　End If
　　MsgBox "データはありません" 'もし、キーワードが見つからなかったら
End Sub

回答No.1

merlionXX · ベストアンサー

前回回答したmerlionXXです。

> この記述だと、一番最初にキーワード１でひっかかったものしかキーワード２を検索しないので・・・。

だって、最初ご提示のコードは転記先が、「別の指定した行」などという変数になっていたので１つしかないものと思いましたよ。
いくつもあるなら変数じゃうけられないでしょ。
以下の前提でかきます。

元データはSheet1にある。
該当した行は、Sheet2に1行目から順に転記する。
実際にはシート名はちがうでしょうから
　　Set ws(1) = Sheets("Sheet1")
　　Set ws(2) = Sheets("Sheet2")
の部分を修正してください。

Sub test03()
　　Dim ws(1 To 2) As Worksheet
　　Dim Keyword, Keyword2
　　Dim Fnd As Range, Fnd2 As Range, c As eange
　　Dim i As Long, ad As String
　　Set ws(1) = Sheets("Sheet1")
　　Set ws(2) = Sheets("Sheet2")
　　'入力されたキーワードを変数Keywordに入れる
　　Keyword = InputBox("キーワードを入力してください")
　　Keyword2 = InputBox("キーワード2を入力してください")
　　With ws(1)
　　　　Set Fnd = .Range("C:C").Find(Keyword) 'C列検索
　　　　If Fnd Is Nothing Then 'もし、C列にキーワードが見つからなかったら
　　　　　　MsgBox "データはありません"
　　　　Else 'キーワードが見つかったら
　　　　　　ad = Fnd.Address 'アドレスを控える
　　　　　　Do '繰り返し
　　　　　　　　For Each c In .Range("E" & Fnd.Row).Resize(, 22)
　　　　　　　　　　If c.Value = Keyword2 Then 'Keyword2検索
　　　　　　　　　　　　i = i + 1
　　　　　　　　　　　　c.EntireRow.Copy ws(2).Rows(i) 'Keyword2が見つかったセルを含む行全体をコピペ
　　　　　　　　　　　　Exit For
　　　　　　　　　　End If
　　　　　　　　Next c
　　　　　　　　Set Fnd = .Range("C:C").FindNext(Fnd) '検索続行
　　　　　　Loop While Not Fnd Is Nothing And Fnd.Address <> ad
　　　　End If
　　End With
End Sub

お礼

たびたび、どうもすみませんです。＞Д＜

本業の合間にやっておいてと言われたもので、VBAは本当にさわり程度しか・・・・。
今、仕事の合間に本を見て理解に励んでいます。

皆さんはやはり専門に勉強なさったのですか？
それとも独学なのでしょうか。

何か、コツがあったら教えていただきたいです。