VBAで列の検索抽出について

質問

EXCEL2003のマクロについて質問です。InStr構文でうまくできませんでした。
SHEET1のA列（A1～A9000）に文章データが9000あり、SHEET2Ａ列（Ａ１～A500）に単語が500ある時、SHEET2のA列にある500の単語の中で１つでもSHEET１のＡ列の文章の中に含まれているセルがある場合を別シート（SHEET3）に抽出したい場合はどのようなマクロを組めばいいのでしょうか？
宜しくおねがいします。

回答No.2

tom04 · ベストアンサー

こんばんは！
一例です。
Sheet1・Sheet2ともデータは1行目からあるとします。

Sub test()
Dim i As Long, k As Long, M As Long
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
For k = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(ws1.Cells(i, 1), ws2.Cells(k, 1)) And _
WorksheetFunction.CountIf(ws3.Columns(1), ws2.Cells(k, 1)) = 0 Then
M = M + 1
ws3.Cells(M, 1) = ws2.Cells(k, 1)
End If
Next i
Next k
End Sub

こんな感じではどうでしょうか？

※　Sheet1・Sheet2の全データでLoopさせていますので、
結構時間を要すると思います。m（_ _）m

お礼

ご連絡遅くなり申し訳ありません。
ご回答ありがとうございました。

回答No.1

crowswork

InStr構文は、文字列を比較し文字列の位置を返すだけです。

まずは、1セル分だけを考えて下さい。
SHHET1＿セル：A1に対して、SHEET2＿セル：A1の単語をInStr構文で比較します。
文字列の位置が返ってくれば同じ文字列があるということですので、
同じ文字列がある場合は、SHEET3のセル：A1に貼り付ける。
文字列がない場合は処理を抜ける。

上記1セル分の処理を
　SHHET1＿セル：A1に対して、SHEET2＿A列のセルを1セルづつループ処理させる。
へ拡張する。

上記ループ処理を
　SHEET＿A列のセルを1セルづつループ処理させる。
へさらに拡張する。

このようなマクロを順を追って作成していけば、最終的にご希望のマクロにたどりつくのではないでしょうか。

参考URL：

http://www.moug.net/tech/exvba/0140043.html

お礼

ご連絡遅くなり申し訳ありません。
ご回答ありがとうございました。