Excel ： 正規表現を利用して２文字の全角数字を半角数字に変換するには？

質問

アクティブセルの文字を、正規表現を利用して文字の変換をしたいと考えています。
２文字の全角数字を半角数字に変換します。
かつ、３文字以上の全角数字は変換しません。

下記のようにコードを書いたのですが、希望通りに動作してくれません。
どこが悪いのでしょうか？
ご指摘いただければ幸いです。
よろしくお願いいたします。

※参照可能なライブラリファイルにて、「Microosft VBScript Regular Expressions 5.5」に
　チェックは入れています。

Sub sample()
　　Dim str
　　Dim strPattern As String
　　Dim strReplacement As String

　　str = ActiveCell.Value
　　str = myRegExp(str, "([^０１２３４５６７８９])([０１２３４５６７８９]{2})([^０１２３４５６７８９])", "$1$2$3")
　　ActiveCell.Value = str
End Sub

Private Function myRegExp(str, strPattern, strReplacement)
　　Dim objRegExp As RegExp
　　Dim test As String
　　Set objRegExp = New RegExp

　　With objRegExp
　　　　.Pattern = strPattern
　　　　.IgnoreCase = False
　　　　.Global = True
　　　　myRegExp = .Replace(str, "$1" & StrConv("$2", vbNarrow) & "$3")
　　End With

　　Set objRegExp = Nothing
End Function

回答No.2

Wendy02 · ベストアンサー

こんばんは。

.Global =True にしてあるので、それをそのままにして作ってみました。

一応、CreateObject("VBScript.RegExp")　で、オートメーション・オブジェクトを作っていますが、必要に応じて直してください。私は、$2 だけを取り出してみました。関数は、重複を避けるために、myRegExp2としました。

それから、myRegExp関数の　strReplacement の引数は、生きていませんね。

Sub sample2()
　　Dim str As String
　　Dim strPattern As String
　　str = ActiveCell.Value
　　str = myRegExp2(str, "([^０-９])([０-９]{2})([^０-９])")
　　ActiveCell.Value = str
End Sub

Private Function myRegExp2(str, strPattern)
　Dim Matches As Object 'MatchCollection
　Dim Match As Object 'as Match
　Dim buf As String
　Dim buf2 As String

　With CreateObject("VBScript.RegExp")
　　.Pattern = strPattern
　　.IgnoreCase = False
　　.Global = True
　　If .Test(str) Then
　　　Set Matches = .Execute(str)
　　　buf2 = str
　　　For Each Match In Matches
　　　　buf = StrConv(.Replace(Match.Value, "$2"), vbNarrow)
　　　　buf2 = Replace(buf2, Match.Value, .Replace(Match.Value, "$1" & buf & "$3"))
　　　Next
　　　myRegExp2 = buf2
　　　Set Matches = Nothing
　　Else
　　　myRegExp2 = str
　　End If
　End With

End Function

お礼

自分の知識ですと、コードの内容を理解するのに、
時間を要してしまいましたが、
ついに自分のコードの間違いに気づきました。
ありがとうございました。
また、正規表現の使い方もさらに詳しくなりました。
大変勉強させていただきました。

ただ、オートメーション・オブジェクトの意味が分かりませんでした。
CreateObject("VBScript.RegExp")　と Set objRegExp = New RegExp の違いは何なのでしょうか？
また、どういった場合に作り直す必要が生じるのでしょうか？

回答No.3

Wendy02

こんにちは。

>CreateObject("VBScript.RegExp")　と Set objRegExp = New RegExp の違いは何なのでしょうか？

前者が、実行時バインディングで、後者は、事前に、参照設定されているので、事前バインディングといいます。後者の事前バインディングのほうが、高速に作動します。また、生成したオブジェクトの残し忘れなどなくてすみます。変数の定義、インテリセンスの利用など、事前バインディングのほうが、作成には有利です。

しかし、事前バインディングは、ユーザーに参照設定してもらう必要があります。CreateObject の実行時バインディングで、明示的にオブジェクトを作ることによって、問題が発生したときの、その問題の部分がより明確になります。相手の環境が不確定な場合は、この実行時バインディングを使用します。

お礼

とても分かりやすくご説明いただきありがとうございます。
そのような使い分けがあるとは全く知りませんでした。
今後は意識しながらマクロを作るようにしていきたいと思います。

回答No.1

BLUEPIXY

さしあたりこんな感じ
----------------------------------------------------------------
Sub sample()
Dim str
Dim strPattern As String
Dim strReplacement As String

str = ActiveCell.Value
str = myRegExp(str, "([^０１２３４５６７８９])([０１２３４５６７８９]{2})([^０１２３４５６７８９])")
If str <> "" Then
ActiveCell.Value = str
End If
End Sub

Private Function myRegExp(str, strPattern)
Dim objRegExp As RegExp
Dim oMatches, oMatch
Set objRegExp = New RegExp

With objRegExp
.Pattern = strPattern
.IgnoreCase = False
' .Global = True
Set oMatches = .Execute(str)
If oMatches.Count <> 0 Then
Set oMatch = oMatches(0)
myRegExp = .Replace(str, "$1" & StrConv(oMatch.SubMatches(1), vbNarrow) & "$3")
Else
myRegExp = "" 'マッチしない
End If
End With

Set objRegExp = Nothing
End Function

お礼

SubMatchesを使用する方法もあるのですね。
勉強になりました！
ありがとうございました。