Excel 複数キーワードの確認方法

素人質問ですみません。
Excelブックにシートが10枚程度有る内容で、
横並びセル2箇所に別キーワードが有る物を探す方法を確認したいです。

現在はExcelの検索でキーワード1のみ入れ、都度キーワード2が見つかるまで見て探しています。
イメージで言いますと下記の様にExcelに入れている場合、キーワード1がA社、キーワード2がA品と言う具合です。検索範囲はExcelブック内のシート全てとなります。10シート有れば10シートと言う意味ですので、Excelブック全てと言った方が良いでしょうか？

販売先Ａ社 B品 仕入れ先名
販売先B社 B品 仕入れ先名
販売先C社 B品 仕入れ先名
販売先Ａ社 A品 仕入れ先名
販売先B社 A品 仕入れ先名
販売先C社 A品 仕入れ先名

ご知見有りましたら、宜しくお願いいたします。

質問者からの補足コメント

• 回答者： tom04　様
  
  追加でご存知でしたら、サンプルはA列とB列にしましたが、例えばE列とF列に変更する場合もご教示いただけますと幸いです。

    補足日時：2016/09/02 19:32

No.5 ベストアンサー 回答者： tom04 回答日時： 2016/09/06 18:07

あ”～～～！

どうも失礼しました。
ドット「.」が抜けていました。

If InStr(.Cells(i, "E"), myStr1) > 0 Then
If InStr(.Cells(i, "F"), myStr2) > 0 Then

のように「Cells」の前に「.」を追加してください。

※　本来であれば
If InStr(Worksheets(k).Cells(i, "E"), myStr1) > 0 Then
If InStr(Worksheets(k).Cells(i, "F"), myStr2) > 0 Then
のようなコードになるのですが、
「Worksheets(k)」を何度も記載するのが面倒なので
＞With Worksheets(k)
として
省略しています。
「.」を付けることにより「Worksheets(k)」の・・・
という意味になります。
「.」がないとSheetを指定していないコトになりますので、
アクティブなSheetを参照し、すべてのSheetに色が付いたのだと思います。

どうも失礼しました。m(_ _)m

この回答へのお礼

御連絡有難うございました。
早々に確認させて頂きました。

結果、考えていた内容となり、非常に感動しております。
誠に有難うございました。
小生はソフト作成等は良く解っておりませんが、この様なことが出来ると楽しいと思いました。

今回は色々と何度もお手を加えて頂き、有難うございました。

感謝申し上げます。

お礼日時：2016/09/06 19:21

No.4 回答者： tom04 回答日時： 2016/09/06 14:52

お礼欄を拝見しました。

結局完全一致ではなく、部分一致（キーワードが含まれる）セルを検索すればよいのですね？

No.3で訂正した
＞If .Cells(i, "E") = myStr1 Then
＞If .Cells(i, "F") = myStr2 Then
の2行を

＞If InStr(Cells(i, "E"), myStr1) > 0 Then
＞If InStr(Cells(i, "F"), myStr2) > 0 Then
としてみてください。m(_ _)m

この回答へのお礼

早々の御連絡有難うございました。
早速頂きました情報にて実施して見ましたが、
見ているシートのE・Fの5に対象キーワードが有るとした場合、
見ているシートは問題無く黄色に塗られ確認出来ています。
但し、全てのシートでE・Fの5が黄色くなる現象が出ています。
下記が頂きました情報として入れている内容となります。

改めてご確認頂ければ幸いです。

＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊

Sub Sample2()
Dim i As Long, k As Long, myStr1 As String, myStr2 As String
myStr1 = Application.InputBox("キーワード1を入力")
myStr2 = Application.InputBox("キーワード2を入力")
For k = 1 To Worksheets.Count
With Worksheets(k)
For i = .Cells(Rows.Count, "E").End(xlUp).Row To 1 Step -1
If InStr(Cells(i, "E"), myStr1) > 0 Then
If InStr(Cells(i, "F"), myStr2) > 0 Then
.Cells(i, "E").Resize(, 2).Interior.ColorIndex = 6
Exit For
End If
End If
Next i
End With
Next k
End Sub


＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
お手すきの際に、宜しくお願いいたします。

お礼日時：2016/09/06 16:14

No.3 回答者： tom04 回答日時： 2016/09/02 19:41

続けておじゃまします。

投稿後補足コメントを見ました。

＞例えばE列とF列に変更する場合・・・
というコトですので、

No.2のコード内の
＞For i = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
＞If .Cells(i, "A") = myStr1 Then
＞If .Cells(i, "B") = myStr2 Then
＞.Cells(i, "A").Resize(, 2).Interior.ColorIndex = 6
の4行を

＞For i = .Cells(Rows.Count, "E").End(xlUp).Row To 1 Step -1
＞If .Cells(i, "E") = myStr1 Then
＞If .Cells(i, "F") = myStr2 Then
＞.Cells(i, "E").Resize(, 2).Interior.ColorIndex = 6

のように列番号だけを変更してみてください。m(_ _)m

この回答へのお礼

小生、出張となりましたため、確認・御連絡遅くなりました。
確認しました所、やりたい内容が確認出来ました。
誠に有難うございました。

但し、セル内のキーワード文言ですが、セル内のコメントが全て同じで無いと検索が出来ない様子です。

やりたい例として....
セル内コメント　・A社A支店　・A品C系とある場合、キーワード1がA社　キーワード2がA品と入力すれば検索出来るとなります、より効率的であると思いました。

お願いばかりで恐縮ですが、上記の内容が出来ると言う手法があるので有れば、
お知らせ頂ければ幸いです。

急ぎではございませんので、お手すきの際で結構です。

宜しくお願いいたします。

お礼日時：2016/09/06 14:19

No.2 回答者： tom04 回答日時： 2016/09/02 19:34

No.1です。

＞下側から探せればよりありがたいと思います。
というコトですので、↓のコードに変更してください。
配置は前回同様だとします。

Sub Sample2()
Dim i As Long, k As Long, myStr1 As String, myStr2 As String
myStr1 = Application.InputBox("キーワード1を入力")
myStr2 = Application.InputBox("キーワード2を入力")
For k = 1 To Worksheets.Count
With Worksheets(k)
For i = .Cells(Rows.Count, "A").End(xlUp).Row To 1 Step -1
If .Cells(i, "A") = myStr1 Then
If .Cells(i, "B") = myStr2 Then
.Cells(i, "A").Resize(, 2).Interior.ColorIndex = 6
Exit For
End If
End If
Next i
End With
Next k
End Sub

こんな感じではどうでしょうか？m(_ _)m

No.1 回答者： tom04 回答日時： 2016/09/02 16:36

こんにちは！

VBAになりますが一例です。

＞横並びセル2箇所に別キーワードが有る物を探す方法・・・
とありますが、具体的な配置が判らないので、すべてのSheetが↓の配置のように
A列に「キーワード1」、B列に「キーワード2」が入っているとします。
そして見つかった場合はどうすればよいのか判らないので「黄色」で塗りつぶすようにしてみました。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）マクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から//
Dim k As Long, myStr1 As String, myStr2 As String
Dim myFound As Range, myFirst As Range
myStr1 = Application.InputBox("A列のキーワード1を入力")
myStr2 = Application.InputBox("B列のキーワード2を入力")
For k = 1 To Worksheets.Count
With Worksheets(k)
Set myFound = .Range("A:A").Find(what:=myStr1, LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then
Set myFirst = myFound
GoTo 処理
Do
Set myFound = .Range("A:A").FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
処理:
If myFound.Offset(, 1) = myStr2 Then
myFound.Resize(, 2).Interior.ColorIndex = 6 '←黄色★
Exit Do
End If
Loop
End If
End With
Next k
End Sub 'この行まで//

※　最初にヒットした行が見つかればそのSheetはそこでやめています。

※　インプットボックスが表示されますので
それぞれに「キーワード1」と「キーワード2」を入力してください。m(_ _)m

この回答へのお礼

早速の御連絡ありがとうございました。

頂きました情報で確認出来ましたが、
同じ内容の次を探す場合はどの様にすれば良いのか？解りませんでした。

こちらの都合でExcelデータは履歴が古いのがExcelの上側で履歴が新しいのが下側になりますので、下側から探せればよりありがたいと思います。

お手すきの際に御教示頂ければ幸いです。

宜しくお願いいたします。

お礼日時：2016/09/02 18:46