エクセル マクロ 英語のデータから検索

質問

どなたかご教示頂ければ幸いです。

以下のようなデータがある場合に、
Japanese team
Made in Japan
in the Japanese music scene
American team
Made in USA
in the American music scene

次のようなＶＢＡを作りました。

Sub macro1()

Dim re, strpattern As String, i As Long, msg As String, rematch

Set re = CreateObject("vbscript.regexp")
strpattern = "japan.*"
With re

.Pattern = strpattern
.ignorecase = True
.Global = True
For i = 1 To 10

Set rematch = .Execute(Cells(i, 1))

If rematch.Count > 0 Then
msg = msg & rematch(0) & vbCrLf
End If

Next i

End With
MsgBox msg

Set rematch = Nothing
Set re = Nothing

End Sub

すると、msgボックスには
Japanese team
Japan
Japanese music sceneと表示されます。

私はヒットしたセルの内容を、以下のように全て表示させたいと思っております。
Japanese team
Made in Japan
in the Japanese musci sceneと・・・

どうすればよろしいでしょうか？

是非とも宜しくお願い申し上げます。

回答No.3

jcctaira

> もしよろしければ、検索ワードをjapanの代わりに、例えばA1セルという風に
> セルを指定する場合は、strpattern = 以降に何と定義付ければよろしいか

次のようにすれば良いと思います。
strpattern = "japan.*"
　　　　　↓
strpattern = Range("A1") & ".*"

注）iが１から始まると"A1"も検索してしまうので２行目以降をデータにし検索するのだと思います？
For i = 1 To 10
　　　　　↓
For i = 2 To 11

回答No.2

imogasi

標準モジュールに
Sub macro1()
Dim re, strpattern As String, i As Long, msg As String, rematch
Set re = CreateObject("vbscript.regexp")
strpattern = "japan.*"
j = 2
With re
.Pattern = strpattern
.ignorecase = True
.Global = True
d = Range("A65536").End(xlUp).Row
MsgBox d
For i = 1 To d
Set rematch = .Execute(Cells(i, "A"))

If rematch.Count > 0 Then
For Each Match In rematch 'msg = msg & rematch(0) & vbCrLf
'MsgBox Match
Cells(j, "D") = Match
Cells(j, "F") = Match.firstIndex
j = j + 1
Next
End If

Next i

End With

Set rematch = Nothing
Set re = Nothing

End Sub
ーーー
例データ
シートのＡ列に
Japanese team
Made in Japan
in the Japanese music scene
American team
Made in USA
in the American music scene
ancient japanese
ーーーーーー
結果
Ｄ列　　　Ｆ列
Japanese team 0
Japan 8
Japanese music scene 7
japanese 8
ーーーーーーーーーーーーーーー
元の全文なら
Sub macro2()
Dim re, strpattern As String, i As Long, msg As String, rematch
Set re = CreateObject("vbscript.regexp")
strpattern = "japan.*"
j = 2
With re
.Pattern = strpattern
.ignorecase = True
.Global = True
d = Range("A65536").End(xlUp).Row
MsgBox d
For i = 1 To d
Set rematch = .Execute(Cells(i, "A"))

If rematch.Count > 0 Then
Cells(j, "G") = Cells(i, "A")
j = j + 1
End If
Next i
End With

Set rematch = Nothing
Set re = Nothing

End Sub

回答No.1

jcctaira

セルの内容を表示したいとのことだと思います。
それなら、以下のように変更すれば良いと思います。

msg = msg & rematch(0) & vbCrLf
　　　　　　　↓
msg = msg & Cells(i, 1) & vbCrLf

お礼

私の舌足らずの説明を斟酌していただいてありがとうございます。

大変参考になりました。明日、早速会社で利用させていただきます。

もしよろしければ、検索ワードをjapanの代わりに、例えばA1セルという風に
セルを指定する場合は、strpattern = 以降に何と定義付ければよろしいか
ご教示頂ければ幸いです。

何卒よろしくお願い申し上げます。