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

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

次のようなVBAを作りました。

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と・・・

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

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

このQ&Aに関連する最新のQ&A

A 回答 (3件)

> もしよろしければ、検索ワードをjapanの代わりに、例えばA1セルという風に


> セルを指定する場合は、strpattern = 以降に何と定義付ければよろしいか

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

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

標準モジュールに


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
ーーー
例データ
シートのA列に
Japanese team
Made in Japan
in the Japanese music scene
American team
Made in USA
in the American music scene
ancient japanese
ーーーーーー
結果
D列   F列
Japanese team0
Japan8
Japanese music scene7
japanese8
ーーーーーーーーーーーーーーー
元の全文なら
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
    • good
    • 0

セルの内容を表示したいとのことだと思います。


それなら、以下のように変更すれば良いと思います。

msg = msg & rematch(0) & vbCrLf
       ↓
msg = msg & Cells(i, 1) & vbCrLf
    • good
    • 0
この回答へのお礼

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

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

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

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

お礼日時:2011/04/11 21:36

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング

おすすめ情報