Excelで文章から特定の単語を抜き出したい

Exel2007で、文章中から特定の単語を抜き出したいと考えています。
1）単語は複数あり、今後増える可能性や変更されることがあります。
2）文章は複数あり、今後増える可能性や変更されることがあります。
3）単語は文章中に複数ある場合や、全くない場合など様々です。
4）単語が見つかった場合、それを文章の横などに表示したいです。
こういった場合、どういった方法があるでしょうか？

A列　　　　　B列　　　　　　　　　　　　C列
単語　　　　文章　　　　　　　　　　　　抽出した単語
●●　　　　▲▲は□□です。　　　　▲▲
■■　　　　○○は■■です。　　　　■■
▲▲　　　　●●は□□です。　　　　●●
　・　　　　　▲▲は■■です。　　　　▲▲　■■
　・　　　　　○○は□□です。　　　　
　・　　　　　▲▲は▲▲です。　　　　▲▲

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

No.2 ベストアンサー 回答者： keithin 回答日時： 2011/09/25 11:05

１つのセルの中に「▲▲　■■」のように２つ以上の結果を出させるのは合理的な方法がないので，C列に１つ目のヒットした単語，D列に２つ目の単語，のように表示させます。

C2に
=IF(COLUMN(A2)>SUMPRODUCT(COUNTIF($B2,"*"&OFFSET($A$1,0,0,COUNTA($A:$A),1)&"*")),"",INDEX($A:$A,SMALL(IF(ISNUMBER(FIND(OFFSET($A$1,0,0,COUNTA($A:$A),1),$B2)),ROW(OFFSET($A$1,0,0,COUNTA($A:$A),1)),999),COLUMN(A2))))
と記入してコントロールキーとシフトキーを押しながらEnterして入力する
C2を右に下にコピーしておく。




＃どうしても１つのセルに結果を出させたいときは，マクロを使って自作の関数を作成した方が簡単です。

参考：
ALT+F11を押してVBE画面を出す
挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

Private Function myS(a As Range, b As Range)
　Dim Target As Range
　Dim h As Range
　Dim res As String
　Set a = a.Cells(1)
　Set Target = Application.Intersect(b, b.Parent.UsedRange)

　For Each h In Target
　If InStr(a, h) Then
　res = res & h & " "
　End If
　Next
　myS = Application.Trim(res)
End Function


ファイルメニューから終了してエクセルに戻り，セルに
=mys(B2,A:A)
のように記入して計算させる。

この回答へのお礼

ありがとうございます！できました！
両方試してみたのですが、マクロの方は処理が重すぎて現実的では無さそうなので関数の方で行きたいと思います。
ただ、間に列を増やすとおかしくなってしまいました。

A列　　B列　　C列　　D列
　　　　単語　　　　　　文章

とすると関数の「A列」を「B列」に、「B列」を「D列」に書き換えてもうまくいきません・・・
でも本当に助かりました！

お礼日時：2011/09/25 11:47

No.4 回答者： kagakusuki 回答日時： 2011/09/25 14:29

　簡単な方法として、作業用シートを設けるという方法もあります。

　今仮に、元データが存在するシートがSheet1であり、Sheet2を作業用シートとして使用するものとします。
　まず、Sheet2のA1セルに次の関数を入力して下さい。

=IF(AND(INDEX(Sheet1!$A:$A,ROW(Sheet1!$A$1)+COLUMN())<>"",ISNUMBER(FIND(INDEX(Sheet1!$A:$A,ROW(Sheet1!$A$1)+COLUMN()),INDEX(Sheet1!$B:$B,ROW(Sheet1!$B$1)+ROW()-1)))),ROW(Sheet1!$A$1)+COLUMN(),"")

　次に、Sheet2のA1セルをコピーして、縦方向はSheet1のB列において文章を入力する欄の行数を上回るのに充分な行数、横方向はSheet1のA列において単語入力する欄の行数を上回るのに充分な列数、をカバーする範囲に貼り付けて下さい。

　次に、Sheet1のC2セルに次の関数を入力して下さい。

=IF(COLUMNS($C:C)>COUNT(OFFSET(Sheet2!$1:$1,ROWS($1:2)-1,)),"",INDEX($A:$A,SMALL(OFFSET(Sheet2!$1:$1,ROWS($1:2)-1,),COLUMNS($C:C))))

　次に、Sheet1のC2セルをコピーして、抽出した単語を表示させたい全てのセルに貼り付けて下さい。

　以上です。

この回答へのお礼

ありがとうございます。
試してみます。

お礼日時：2011/09/25 15:03

No.3 回答者： tom04 回答日時： 2011/09/25 12:02

こんにちは！

VBAになってしまいますが・・・一例です。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）
データは2行目からあるとします。

Sub test() 'この行から
Dim i, j, k As Long
Dim str, buf As String
For j = 2 To Cells(Rows.Count, 2).End(xlUp).Row
For k = 1 To Len(Cells(j, 2))
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
str = Mid(Cells(j, 2), k, Len(Cells(i, 1)))
If str = Cells(i, 1) And Not buf Like "*" & str & "*" Then
buf = buf & str & " "
End If
Next i
Next k
Cells(j, 3) = Trim(buf)
buf = ""
Next j
Columns(3).AutoFit
End Sub 'この行まで

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

この回答へのお礼

ありがとうございます。
途中までうまく行ったのですが、「パターン文字列が不正です。」とダイアログが出て止まってしまいました。
おそらく、文章の中に同じ単語が出てくるとダメみたいです。

お礼日時：2011/09/25 12:59