エクセル セル内にリスト化された特定文字列の検索

セルが下記の文字列を含みます、その際に各セルに検索候補キーが含まれるかどうかを
チェックしたいのが目的となります。
ググったりINDEXとかいろいろ使ってみたのですがうまくいかずお助けください。

任意の文字列がはいったセル
A1: 明日天気になれ
A2: 晴れです、明後日は
A3: 吹雪、嵐です
A4: 中央高速
A5: 首都高速

検索したいキーワード
D1:明日
D2:嵐
D3:首都


得たい結果
任意の文字列を含むセルが複数（A:A）あり、そのセル内にリスト化(D1:D3)されたいくつかの
キーワードが含まれるか検索し、ヒットした場合、そのキーワードを表示するというものです。

期待される出力結果
A1: 明日天気になれ　　　　　　　　　　B1:明日
A2: 晴れです、明後日は　　　　　　　　B2:
A3: 吹雪、嵐です　　　　　　　　　　　　B3:嵐　　　
A4: 中央高速　　　　　　　　　　　　　　B4:　　　
A5: 首都高速　　　　　　　　　　　　　　B5:首都　　

尚、Aには検索したい複数のキーワードは同時に含まれていないという前提での処理で
かまいません。（今後精査する可能性はでてきそうですが、、）


よろしくお願いいたします。

No.9 回答者： tom04 回答日時： 2012/09/05 17:22

こんにちは！

VBA向きの質問だと思います。

すでに回答は出ていますので、参考程度で・・・

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i As Long, k As Long, buf As String
Columns(2).ClearContents
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
buf = ""
For k = 1 To Cells(Rows.Count, "D").End(xlUp).Row
If InStr(Cells(i, "A"), Cells(k, "D")) Then
buf = buf & Cells(k, "D") & ","
End If
Next k
If Len(buf) > 0 Then
Cells(i, "B") = Left(buf, Len(buf) - 1)
End If
Next i
End Sub 'この行まで

※　A列セル内に候補が複数あればすべて表示するようにしたみました。

こんな感じではどうでしょうか？m（_ _）m

No.8 回答者： kagakusuki 回答日時： 2012/09/05 16:27

　B1セルに次の数式を入力してから、B1セルをコピーして、B2以下に貼り付けて下さい。

=REPLACE(IF(ISNUMBER(FIND($D$1,INDEX($A:$A,ROW()))),","&$D$1,"")&IF(ISNUMBER(FIND($D$2,INDEX($A:$A,ROW()))),","&$D$2,"")&IF(ISNUMBER(FIND($D$3,INDEX($A:$A,ROW()))),","&$D$3,""),1,1,)

　これで、A列のセルに、例えば「首都の嵐」といった、複数のキーワードに該当する文字列が入力された場合には、

嵐,首都

という様に、該当する複数のキーワードを、「,」(カンマ)で区切った形で並べた文字列が、B列のセルに表示されます。

No.7 回答者： JazzCorp 回答日時： 2012/09/05 15:36

部分一致で検索

マッチするものが複数あるときは並べて出力
適当なデリミタを付加することも、それなりに簡単にできるでしょう。
Ｂ１：
=IF(ISERROR(FIND(D$1,A1)),"",D$1)&IF(ISERROR(FIND(D$2,A1)),"",D$2)&IF(ISERROR(FIND(D$3,A1)),"",D$3)
以下、コピー

No.6 回答者： MackyNo1 回答日時： 2012/09/05 11:58

関数で対応するなら以下のような関数をB1セルに入力してCtrl+Shift+Enterで確定してください。

=IF(COUNT(0/FIND($D$1:$D$3,A1)),INDEX(D:D,MAX(ISNUMBER(FIND($D$1:$D$3,A1))*ROW($D$1:$D$3))),"")

No.5 回答者： KURUMITO 回答日時： 2012/09/05 11:49

回答Ｎ２，３です。

関数で式をＤ３以下のセルに対しても適用できるようにあらかじめ追加した式にしておけばよいのですがＤ列のキーワードが多くなればマクロによる対応になりますね。
Ａ列やＤ列では空白の行が無くデータが入力されているのでしたら次のマクロで良いでしょう。
該当のシート見出しで右クリックして「コードの表示」を選択します。
表示の画面には次のコードを入力します。

Sub 特定文字列検索()
Dim i, n As Long
If Range("D1") = "" Then Exit Sub
For i = 1 To Range("D1").End(xlDown).Row
n = 0
Do
n = n + 1
Set c = Cells(n, 1).Find(What:=Cells(i, 4).Value, Lookat:=xlPart)
If Not c Is Nothing Then
Cells(n, 2) = Cells(n, 2).Value & Cells(i, 4).Value
End If
Loop Until Cells(n, 1) = ""
Next
End Sub

マクロを実行する場合には「開発」タブの「マクロ」から「特定文字列検索」を選択して「実行」をクリックします。

No.4 回答者： emsuja 回答日時： 2012/09/05 10:30

#1 です

補足の内容は検索キーワードの数を将来的に増やす事がある、その場合マクロの記述内容を修正したくないとのことでいいのですね？
通常、プログラムを書く場合はある程度そのような事態は事前に想定しておきます。

A 列の被検索文字列、D 列のキーワード共に項目数が変化する前提の場合
A D 列とも必ず一行目からデータが始まり、空白の項目が見つかった時まで処理するならば

ar = 0　　　　　　' A 列のカウンタをリセット
Do
　ar = ar +1　　　' A　列のカウンタを一つアップ
　If Cells(ar,1).value = "" Then Exit Do　　　' A 列空白なら抜け出る
　dr = 0　　　　　' D 列のカウンタをリセット
　Do
　　dr = dr + 1　　' D 列のカウンタを一つアップ
　　If Cells(dr,4).Value = "" Then Exit Do　　' D 列空白なら抜け出る

　　' セル( dr,4) に記述されたキーワードが セル( ar,1) に存在するかどうかの処理
　Loop

Loop

これでよいのではと思います

No.3 回答者： KURUMITO 回答日時： 2012/09/05 10:15

回答2です。

Ｄ列に検索文字が追加された場合には同様の式を追加すればよいでしょう。
このような式を使った場合には一つのセルに2つ以上のキーワードが有る場合でも対応して表示されます。

No.2 回答者： KURUMITO 回答日時： 2012/09/05 09:47

Ｂ１セルには次の式を入力して下方にドラッグコピーします。

=IF(COUNTIF(A1,"*"&D$1&"*")>0,D$1,"")&IF(COUNTIF(A1,"*"&D$2&"*")>0,D$2,"")&IF(COUNTIF(A1,"*"&D$3&"*")>0,D$3,"")

No.1 回答者： emsuja 回答日時： 2012/09/05 08:27

検索される文字列の中に特定のキーワードが含まれるかどうかは

Instr が便利です

位置 = Instr(検索される文字列,キーワード) と記述します
検索される文字列に、キーワードが含まれればその始まる位置が
含まれない場合は ゼロ が返されます。
後は簡単なループを記述するだけですね。

この回答への補足

速レス有難うございます
1点大事な点記載してませんでした
検索キーワードを追加する度にifを多用しているがための修整の繁雑さをなくすため、d列には任意のキーワードを下部に追加できて、且つ関数部分は検索キーワードのリスト範囲を拡げる程度で継続運用できる方法を探しています。
他の方も含め引き続きよろしくお願いします。

補足日時：2012/09/05 09:07