EXCELのマクロで正規表現

質問

EXCELのマクロで正規表現のサイトを色々検索してみましたが
ほとんどが，色を変えたり，置換のことしかのっていません

自分がやりたいことはマッチした部分を隣りのセルに移動させる
といったことです

あいうえお．abcde

A１セルに上記の文があった時に正規表現 [a-zA-Z]+ でマッチした部分 (abcde)を
B1セルに移動する

よろしくお願いします

回答No.2

imogasi · ベストアンサー

標準モジュールに
Sub test01()
'Microsoft VBScipt Regular Expressions 1.0 に参照設定
Set fso = CreateObject("Scripting.FileSystemObject")
d = Range("a65536").End(xlUp).Row
'MsgBox d
For i = 1 To d
j = 6
x = Cells(i, "A")
'MsgBox x
Dim re
Dim mach
Set re = New RegExp
re.Pattern = "[a-zA-Z]+"
Set matchs = re.Execute(x)
For Each mach In matchs
' MsgBox mach.Value
Cells(i, j) = mach.Value
j = j + 1
Next
Next i
End Sub
無理に見やすいように結果はF列に表示。ｊ＝６を２とかにして。
ーー
例と結果
例　下記の英字文字列はこの場合F列
ああいうXabcdG型は安い.fgh型は高い XabcdG
ああYabcdG型は安い.fgh型は高い YabcdG
いうZZabcdG型は安い.fgh型は高い ZZabcdG
あうQQQXabcdG型は安い.fgh型は高い QQQXabcdG
うHUIXabcdG型は安い.fgh型は高い HUIXabcdG
あうKXabcdG型は安い.fgh型は高い KXabcdG

お礼

返信がおそくなりすみません

ほとんどの記述を参考にさせてもらいました

ありがとうございました

回答No.4

ki-aaa

発想の転換が必要です。

[^a-z]で、英字以外を指定することができるので、
英字以外を長さがゼロの文字に置き換えます。
そうすると、英字が残りますので、それを取り出せば、お望みのことができます。

参考URL：

http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_regexp.html

お礼

返信がおそくなりすみません

発想の転換ができていなかったこともあり、やりたいことばかりみていました
すごく良いヒント下さってありがとうございます

回答No.3

mitarashi

移動ではないですが、正規表現を用いたユーザー定義関数を作成した事があります。
B1セルに、次の式を入れると、ヒットすればabcdeを、しなければ#N/Aを戻します。
=extractAlphabet(A1)
スピードは速くはないと思います。
ユーザー定義式のコードは次の通りです。
Function extractAlphabet(targetString As String) As Variant
extractAlphabet = subMatchWord(targetString, "([A-z ]+)")
End Function

Private Function subMatchWord(targetString As String, matchString As String) As Variant
Dim regEX As Variant
Dim Matches As Variant
Dim match As Variant

Set regEX = CreateObject("VBScript.RegExp")
regEX.MultiLine = False
regEX.Pattern = matchString
regEX.ignorecase = True
regEX.Global = False
On Error GoTo errorHandle
Set Matches = regEX.Execute(targetString)

If Matches(0).subMatches.Count > 0 Then
subMatchWord = Matches(0).subMatches.Item(0)
Else
subMatchWord = CVErr(xlErrNA)
End If
Set Matches = Nothing
Set regEX = Nothing
Exit Function
errorHandle:
subMatchWord = CVErr(xlErrNA)
End Function

実際にA1から、"abcde"を削除したい場合は、ユーザー定義式ではなくて、ループを回す必要がありますが、小改造でいけると思います。

お礼

返信が遅くなりすみませんでした

今回の件に関しては他の方の回答を参考にしました

ありがとうございました

回答No.1

tom04

こんばんは！
正規表現とは言い難いかもしれませんが・・・
一例です。

元データはA列1行目以降にあるとして、B列に表示させるとします。
（アルファベットのA～ｚの単なる抜き出しです。）

Sub test()
Dim i, k As Long
Dim str, buf As String
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[A-z]" Then
buf = buf & str
End If
Next k
Cells(i, 2) = buf
buf = ""
Next i
Application.ScreenUpdating = True
End Sub

※　質問では
＞マッチした部分を隣りのセルに移動させる
とありますので、その場合は↓のコードでマクロを試してみてください。

Sub test2()
Dim i, k As Long
Dim str, buf As String
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), k, 1)
If str Like "[A-z]" Then
buf = buf & str
Cells(i, 1) = Replace(Cells(i, 1), str, "*")
End If
Next k
Cells(i, 1) = WorksheetFunction.Substitute(Cells(i, 1), "*", "")
Cells(i, 2) = buf
buf = ""
Next i
Application.ScreenUpdating = True
End Sub

あくまで一例ですので、これがベストだという訳ではありません。m（＿ ＿）m

お礼

返信が遅くなりすみませんでした

今回の件に関しては他の方の回答を参考にしました

ありがとうございました