LoginSignup
2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

@TETSURO1999

[Excel VBA] 廃止される VBScript.RegExp の代替となる正規表現クラスを JScript で作ってみた

Last updated at Posted at 2025-10-05

まず最初に今回の記事のオチを読もう。

概要

Excel VBA にて正規表現クラスを作った。正規表現の取り扱いは JScript 側に一任し，これを ScriptControl 経由で呼び出すようにした。クラス名やメソッド，プロパティなどインタフェースは VBScript の RegExp クラスに限りなく寄せた，いわゆるラッパーを作ったというもの。なお，ScriptControl を用いたことにより，基本的に 32bit 版 Office でしか使えない。

はじめに

VBScript が廃止されるらしい。

Windows Script Host (WSH) で VBScript のソフト資産がある人は JScript や PowerShell に移行せざるを得ないが，まだ VBScript が動いている間に移行テストを行うべきだろう。

問題は Excel VBA で正規表現を使うとき，実は内部で VBScript の正規表現クラス RegExp を使っているのだ。VBScript が廃止されたら当然，これも使えなくなる。最近 Office 365 の VBA で正規表現がサポートされたが，買い切り版では（少なくともこの記事を書いている時点での最新版の Office 2024 でも）未サポートである。おそらく次のアップデート Office 2027(?) まで待たなくてはならない。

それまで買い切り版 Office ユーザーとしては代替案を考えなくてはならない。

  • VBA を用いてフルスクラッチで自作する。
  • SeleniumVBA の Regex-VBA を使う。
  • vb2clr を使用して .NET Framework 4 の機能を利用する。

このうちフルスクラッチで自作することはあり得ない。自作に挑戦した記事を見てみたが，投入するコストに対するリターンが釣り合わない。そういう意味では SeleniumVBA のプロジェクトを尊敬する。彼らはフルスクラッチで実装したからだ。次の vb2clr のプロジェクトは既にある他言語の正規表現機能を利用するという意味でヒントになった。

そう，正規表現が基本言語仕様として組み込まれている JavaScript (JScript) を使えばいいことに気づいた。VBA からは ScriptControl を用いて JavaScript (JScript) のコードを簡単に呼び出せるからだ。であれば，大したコストはかからないので，ちょっと欲張って既存の RegExp クラスの互換品を作ってみることにした。

準備

Excel の VBA エディタの参照設定で Microsoft Script Control 1.0 にチェックを付けておくこと。

実装コード

以下の４つのファイルから構成されている。Excel の VBA エディタからインポートして読み込むこと。

RegExp2.cls のコードはコチラ
RegExp2.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "RegExp2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------------
'【非公開メンバ変数】
'-------------------------------------------------------------------------------
Private oScriptControl  As ScriptControl
'-------------------------------------------------------------------------------
'【コンストラクタ】
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
    Set oScriptControl = New ScriptControl
    oScriptControl.Language = "JScript"
    Dim s   As String
    Dim n   As String
    '---------------------------------------------------------------------------
    '【メンバ変数】
    '---------------------------------------------------------------------------
    s = "": n = vbCrLf
    s = s & n & "var     regExp = null;"
    s = s & n & "var  lastIndex = null;"
    s = s & n & "var globalFlag = false;"
    s = s & n & "var ignoreCase = false;"
    s = s & n & "var  multiLine = false;"
    s = s & n & "var    pattern = null;"
    '---------------------------------------------------------------------------
    '【アクセサ】globalFlag
    '---------------------------------------------------------------------------
    s = s & n & "function setGlobalFlag(flag) {"
    s = s & n & "    if(globalFlag == flag) return;"
    s = s & n & "    globalFlag = flag;"
    s = s & n & "    regexp = null;"
    s = s & n & "}"
    s = s & n & "function getGlobalFlag(flag) {"
    s = s & n & "    return globalFlag;"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【アクセサ】ignoreCase
    '---------------------------------------------------------------------------
    s = s & n & "function setIgnoreCase(flag) {"
    s = s & n & "    if(ignoreCase == flag) return;"
    s = s & n & "    ignoreCase = flag;"
    s = s & n & "    regexp = null;"
    s = s & n & "}"
    s = s & n & "function getIgnoreCase() {"
    s = s & n & "    return ignoreCase;"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【アクセサ】multiLine
    '---------------------------------------------------------------------------
    s = s & n & "function setMultiLine(flag) {"
    s = s & n & "    if(multiLine == flag) return;"
    s = s & n & "    multiLine = flag;"
    s = s & n & "    regexp = null;"
    s = s & n & "}"
    s = s & n & "function getMultiLine() {"
    s = s & n & "    return multiLine;"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【アクセサ】pattern
    '---------------------------------------------------------------------------
    s = s & n & "function setPattern(pat) {"
    s = s & n & "    pattern = pat;"
    s = s & n & "    regexp = null;"
    s = s & n & "}"
    s = s & n & "function getPattern() {"
    s = s & n & "    return pattern;"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【メソッド】初期化
    '---------------------------------------------------------------------------
    s = s & n & "function initial() {"
    s = s & n & "    if(regexp == null) {"
    s = s & n & "        var flags = '';"
    s = s & n & "        if(globalFlag) flags += 'g';"
    s = s & n & "        if(ignoreCase) flags += 'i';"
    s = s & n & "        if(multiLine)  flags += 'm';"
    s = s & n & "        if(flags == '')"
    s = s & n & "            regexp = new RegExp(pattern);"
    s = s & n & "        else"
    s = s & n & "            regexp = new RegExp(pattern, flags);"
    s = s & n & "    }"
    s = s & n & "    regexp.lastIndex = lastIndex = 0;"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【メソッド】Test
    '---------------------------------------------------------------------------
    s = s & n & "function commandTest(str) {"
    s = s & n & "    return regexp.test(str);"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【メソッド】Exec
    '---------------------------------------------------------------------------
    s = s & n & "function commandExec(str) {"
    s = s & n & "    var ret = regexp.exec(str);"
    s = s & n & "    if(ret == null) {"
    s = s & n & "        return {"
    s = s & n & "            FirstIndex: -1,"
    s = s & n & "            Length: -1,"
    s = s & n & "            Value: '',"
    s = s & n & "            SubMatches: []"
    s = s & n & "        };"
    s = s & n & "    } else {"
    s = s & n & "        var all = ret[0];"
    s = s & n & "        var pos = str.indexOf(all, lastIndex);"
    s = s & n & "        lastIndex = regexp.lastIndex;"
    s = s & n & "        return {"
    s = s & n & "            FirstIndex: pos,"
    s = s & n & "            Length: all.length,"
    s = s & n & "            Value: all,"
    s = s & n & "            SubMatches: ret.slice(1)"
    s = s & n & "        };"
    s = s & n & "    }"
    s = s & n & "}"
    '---------------------------------------------------------------------------
    '【メソッド】Replace
    '---------------------------------------------------------------------------
    s = s & n & "function commandReplace(str, rep) {"
    s = s & n & "    return str.replace(regexp, rep);"
    s = s & n & "}"
    oScriptControl.AddCode s
End Sub
'-------------------------------------------------------------------------------
'【アクセサ】GlobalFlag
'-------------------------------------------------------------------------------
Public Property Let GlobalFlag(flag As Boolean)
    CallByName oScriptControl.CodeObject, "setGlobalFlag", vbMethod, flag
End Property
Public Property Get GlobalFlag() As Boolean
    GlobalFlag = CallByName(oScriptControl.CodeObject, "getGlobalFlag", vbMethod)
End Property
'-------------------------------------------------------------------------------
'【アクセサ】IgnoreCase
'-------------------------------------------------------------------------------
Public Property Let IgnoreCase(flag As Boolean)
    CallByName oScriptControl.CodeObject, "setIgnoreCase", vbMethod, flag
End Property
Public Property Get IgnoreCase() As Boolean
    IgnoreCase = CallByName(oScriptControl.CodeObject, "getIgnoreCase", vbMethod)
End Property
'-------------------------------------------------------------------------------
'【アクセサ】MultiLine
'-------------------------------------------------------------------------------
Public Property Let MultiLine(flag As Boolean)
    CalByName oScriptControl.CodeObject, "setMultiLine", vbMethod, flag
End Property
Public Property Get MultiLine() As Boolean
    IgnoreCase = CallByName(oScriptControl.CodeObject, "getMultiLine", vbMethod)
End Property
'-------------------------------------------------------------------------------
'【アクセサ】Pattern
'-------------------------------------------------------------------------------
Public Property Let Pattern(pat As String)
    CallByName oScriptControl.CodeObject, "setPattern", vbMethod, pat
End Property
Public Property Get Pattern() As String
    Pattern = CallByName(oScriptControl.CodeObject, "getPattern", vbMethod)
End Property
'-------------------------------------------------------------------------------
'【メソッド】Test
'-------------------------------------------------------------------------------
Public Function Test(str As String) As Boolean
    CallByName oScriptControl.CodeObject, "initial", vbMethod
    Test = CallByName(oScriptControl.CodeObject, "commandTest", vbMethod, str)
End Function
'-------------------------------------------------------------------------------
'【メソッド】Execute
'-------------------------------------------------------------------------------
Public Function Execute(str As String) As MatchCollection2
    Dim oCollection As New MatchCollection2
    Dim GlobalFlag  As Boolean
    Dim oMatch      As Match2
    Dim oSubMatches As SubMatches2
    Dim obj As Object
    Dim arr As Object
    Dim i   As Long
    Dim n   As Long
    Dim pos As Long
    CallByName oScriptControl.CodeObject, "initial", vbMethod
    GlobalFlag = CallByName(oScriptControl.CodeObject, "getGlobalFlag", vbMethod)
    Do While True
        Set obj = CallByName(oScriptControl.CodeObject, "commandExec", vbMethod, str)
        pos = CallByName(obj, "FirstIndex", vbGet)
        If pos < 0 Then Exit Do
        Set oMatch = New Match2
        oMatch.FirstIndex = pos
        oMatch.Length = CallByName(obj, "Length", vbGet)
        oMatch.Value = CallByName(obj, "Value", vbGet)
        Set oSubMatches = New SubMatches2
        Set arr = CallByName(obj, "SubMatches", vbGet)
        n = CallByName(arr, "length", vbGet)
        For i = 0 To n - 1
            oSubMatches.Add CallByName(arr, i, vbGet)
        Next
        Set oMatch.SubMatches = oSubMatches
        oCollection.Add oMatch
        If Not GlobalFlag Then Exit Do
    Loop
    Set Execute = oCollection
End Function
'-------------------------------------------------------------------------------
'【メソッド】Replace
'-------------------------------------------------------------------------------
Public Function Replace(str As String, rep As String) As String
    CallByName oScriptControl.CodeObject, "initial", vbMethod
    Replace = CallByName(oScriptControl.CodeObject, "commandReplace", vbMethod, str, rep)
End Function
MatchCollection2.cls のコードはコチラ
MatchCollection2.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "MatchCollection2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------------
'【非公開メンバ変数】
'-------------------------------------------------------------------------------
Private oCollection As Collection
'-------------------------------------------------------------------------------
'【コンストラクタ】
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
    Set oCollection = New Collection
End Sub
'-------------------------------------------------------------------------------
'【アクセサ】Count
'-------------------------------------------------------------------------------
Public Property Get Count() As Long
    Count = oCollection.Count
End Property
'-------------------------------------------------------------------------------
'【アクセサ】Item
'-------------------------------------------------------------------------------
Public Property Get Item(n As Long) As Match2
Attribute Item.VB_UserMemId = 0
    Set Item = oCollection(n + 1)
End Property
'-------------------------------------------------------------------------------
'【アクセサ】NewEnum
'-------------------------------------------------------------------------------
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = oCollection.[_NewEnum]
End Property
'-------------------------------------------------------------------------------
'【メソッド】Add
'-------------------------------------------------------------------------------
Public Sub Add(obj As Match2)
    oCollection.Add obj
End Sub
Match2.cls のコードはコチラ
Match2.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Match2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------------
'【公開メンバ変数】
'-------------------------------------------------------------------------------
Public FirstIndex    As Long
Public Length        As Long
Public SubMatches    As SubMatches2
Public Value         As String
Attribute Value.VB_VarUserMemId = 0
SubMatches2.cls のコードはコチラ
SubMatches2.cls
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "SubMatches2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'-------------------------------------------------------------------------------
'【非公開メンバ変数】
'-------------------------------------------------------------------------------
Private oCollection As Collection
'-------------------------------------------------------------------------------
'【コンストラクタ】
'-------------------------------------------------------------------------------
Private Sub Class_Initialize()
    Set oCollection = New Collection
End Sub
'-------------------------------------------------------------------------------
'【アクセサ】Count
'-------------------------------------------------------------------------------
Public Property Get Count() As Long
    Count = oCollection.Count
End Property
'-------------------------------------------------------------------------------
'【アクセサ】Item
'-------------------------------------------------------------------------------
Public Property Get Item(n As Long) As String
Attribute Item.VB_UserMemId = 0
    Item = oCollection(n + 1)
End Property
'-------------------------------------------------------------------------------
'【アクセサ】NewEnum
'-------------------------------------------------------------------------------
Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = oCollection.[_NewEnum]
End Property
'-------------------------------------------------------------------------------
'【メソッド】Add
'-------------------------------------------------------------------------------
Public Sub Add(str As String)
    oCollection.Add str
End Sub

比較表

VBScript 版の RegExp クラスにクラス名やプロパティ，メソッド名は限りなく寄せたが，敢えて全く同じ名前にするのは避けてクラス名の末尾にはすべて 2 を付けた。また，プロパティの Global は予約語として存在するため，GlobalFlag に名前を変えた。

※印は既定のプロパティを示し，表記を省略することができるというもの。

表１　正規表現クラスの比較
クラス 項目 VBScript版 JScript版
正規表現 クラス RegExp RegExp2
プロパティ Global
IgnoreCase
MultiLine 		GlobalFlag
IgnoreCase
MultiLine
メソッド Test
Execute
Replace 		Test
Execute
Replace
マッチコレクション クラス MatchCollection MatchCollection2
プロパティ Count
Item※ 		Count
Item※
メソッド Add
マッチオブジェクト クラス Match Match2
プロパティ FirstIndex
Length
Value※
SubMatches 		FirstIndex
Length
Value※
SubMatches
メソッド
サブマッチコレクション クラス SubMatches SubMatches2
プロパティ Count
Item※ 		Count
Item※
メソッド Add

正規表現のコレクションは読み出し専用のため，Remove メソッドは用意していないし，本来 Add メソッドも見えてはいけないように思うのだが，隠し方が分からなかった。

使い方

ループカウンタ変数を用いてインデクス参照するときの例を示す。クラス名の変更（末尾に 2 を付ける）およびプロパティ名の変更 Global → GlobalFlag だけで動く。

For Each ループを用いる場合の例を示す。こちらの変更点も同じである。

ちなみに実行結果は下記のようになる。いずれのマクロも同じ結果となる。

まとめ

  • 今回，アイディアを思いついてから突貫で作ったので，全くもってテスト不足である。バグだらけかもしれない点はご容赦願いたい。とくに大規模運用するとパフォーマンスが不足するかもしれない。
  • 今回 VBScript の既存クラスと名前が衝突しないようにクラス名の末尾に一律 2 を付けたが，同じ名前にしてしまうのもアリかもしれない。その場合の変更点はプロパティ名の変更 Global → GlobalFlag だけでよい。
  • ScriptControl を用いるとデバッグがとても難しい。とくに JavaScript (JScript) 側でエラーが発生するともうお手上げである。
  • 今回の記事は JScript 版の正規表現クラスを使ってみたいという人向けに実装コードを中心にまとめたものである。技術的な解説には興味ない人も多いだろうから，それは別の記事でまとめたい。

今回の記事のオチ

この記事を公開する直前に気づいたが，どうやら買い切り版の Office にも正規表現クラス RegExp が追加されたようでサポート期限が2025年10月14日の Office 2016 / 2019 にも追加されている。もともとセキュリティ上の問題から VBScript を廃止する流れなので，セキュリティアップデートの一環として買い切り版の Office にも正規表現クラスを追加してくれたのだろう。64bit 版 Office でも使えるので嬉しい反面，本記事の JScript 版がただの習作になってしまい悲しくもある。

Excel 2019 のバージョンを確認すると下記の通り。

VBA エディタのオブジェクトブラウザを開くと RegExp クラスが二つあることに気づく。このうち一つは既存の VBScript 版のほうである。参照設定で VBScript RegExp 5.5 のチェックを外すとコチラは消える。一方，新たに追加された RegExp クラスは VBScript 版とメンバーが同じであることが分かる。おそらく完全互換・代替品のつもりで作っていると思われる。

もちろん他のクラス Match, MatchCollection, SubMathces も二つずつある。

参考文献

2
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?