Go to Qiita Advent Calendar Top
LoginSignup
0
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 で作ってみた２～技術解説

Posted at

はじめに

基本的に筆者は技術解説をしながら自作コードを公開するのだが，今回は Office 2016 / 2019 のサポート期限である2025年10月14日も間近に迫ってきていたことから慌てて下記の記事の公開を優先した。

今回の記事は，前回の記事では書き切れなかった技術解説を行いたい。

基本構想

おそらく VBScript の作者は，当時すでに存在していた JavaScript の正規表現クラスを参考にして VBScript 版の正規表現クラスを設計したのではないかと思う。両者はよく似ているうえ，むしろ VBScript 版の$\texttt{Execute()}$メソッドのほうがシンプルで使い易いようにも思える。両者の対応表を以下に示すが，頑張れば VBScript 版の正規表現クラスを JScript でエミュレーションできるように思える。

表１　正規表現クラス$\texttt{RegExp}$のメンバー対応表
VBScript JavaScript 内容
$\texttt{Pattern}$ $\texttt{source}$ 同じ意味。
$\texttt{Global}$ $\texttt{global}$ 同じ意味。
$\texttt{IgnoreCase}$ $\texttt{ignoreCase}$ 同じ意味。
$\texttt{MultiLine}$ $\texttt{multiline}$ 同じ意味。
$\texttt{Test()}$ $\texttt{test()}$ VBScript は$\texttt{Global}$を無視する。JavaScript は$\texttt{global}$設定により照合開始位置が異なる。$\texttt{global}$無効時は文字列の先頭から照合を開始し，$\texttt{global}$有効時は$\texttt{lastIndex}$から開始する。いずれも$\texttt{lastIndex}$を一回分だけ更新する。
$\texttt{Execute()}$ $\texttt{exec()}$ VBScript は$\texttt{Match}$オブジェクトのコレクションを返す。$\texttt{Global}$有効時は一回の呼び出しで全ての照合結果を得ることができる。JavaScript は文字列の配列を返す。$\texttt{global}$無効時は文字列の先頭から照合を開始し，$\texttt{global}$有効時は$\texttt{lastIndex}$から開始する。いずれも$\texttt{lastIndex}$を一回分だけ更新する。$\texttt{global}$有効時も一回の呼び出し当たり一回分の照合結果しか得られないので，全ての照合結果を得るためには$\texttt{null}$が返ってくるまで繰り返して呼び出す必要がある。
$\texttt{Replace()}$ $\texttt{replace()}$ VBScriptは$\texttt{Global}$設定に関わらず文字列の先頭から検索を開始する。JavaScript も$\texttt{global}$設定に関わらず文字列の先頭から検索を開始するので両者は同じ動作になるが，置換後に$\texttt{lastIndex}$を更新するため，$\texttt{lastIndex}$を参照する他のメソッドの動作に影響を及ぼす。

プロパティはそれぞれ同じ意味であり，一対一に対応していて非常に分かり易い。一方，メソッドは名前が似ていても微妙に動作が異なるので注意が必要である。

動作の差異の要因は，JavaScript 側のメソッドが記憶を持つこと，すなわち次回の照合開始位置 $\texttt{lastIndex}$ を持つことに由来する。VBScript 側のメソッドはすべて一回の呼び出しで完了するため，このような記憶を持たない。

VBScript の$\texttt{Execute()}$メソッドは$\texttt{Match}$オブジェクトのコレクションを返す。一方，JavaScript の$\texttt{exec()}$メソッドは文字列の配列を返し，返値$\texttt{ret}$とおくと次のような対応関係になる。

表２　$\texttt{Match}$オブジェクトの対応表
VBScript JavaScript 内容
$\texttt{FirstIndex}$ $\texttt{ret.index}$ 一致した位置
$\texttt{Length}$ $\texttt{ret[0].length}$ 一致した文字列の長さ
$\texttt{Value}$ $\texttt{ret[0]}$ 一致した文字列
$\texttt{SubMatches}$ $\texttt{ret.slice(1)}$ VBscript の$\texttt{SubMatches}$は配列ではなくキャプチャした文字列のコレクション。JavaScript の返す配列$\texttt{ret[]}$の2番目以降の要素に対応する。

JavaScript コード

こうして作成した JavaScript コードを以下に示す。なお，このコードは VBA に文字列として取り込む都合上，二重引用符を使用しないようにした。

また，各プロパティに関してはそれぞれアクセサを設けた。また，インスタンス$\texttt{regexp}$のプロパティには直接書き込まないで，対応するフラグおよび検索文字列

  • $\texttt{globalFlag}$
  • $\texttt{ignoreCase}$
  • $\texttt{multiLine}$
  • $\texttt{pattern}$

を用意し，これらに書き込む。メソッドを呼び出す直前に$\texttt{RegExp}$クラスのコンストラクタを呼び出すようにして，この際にこれらのフラグ等を参照するようにした。

どうしてこのような設計にしたかというと，コンストラクタの呼び出しは正規表現のコンパイルなど比較的重い処理かもしれないのでコンストラクタの呼び出し回数を必要最小限に抑えたかったからだ。このためメソッドの呼び出し直前かつ必要に応じて●●●●●コンストラクタを呼び出すようにした。フラグや検索文字列に変更がない場合はコンストラクタを呼び出さない。この結果，VBA 側からプロパティを参照する際にはインスタンス$\texttt{regexp}$がまだ作成されていない場合がある。

JavaScript コード
//--------------------------------------------------------------------------
//【メンバ変数】
//--------------------------------------------------------------------------
var     regexp = null;
var globalFlag = false;
var ignoreCase = false;
var  multiLine = false;
var    pattern = null;
//--------------------------------------------------------------------------
//【アクセサ】globalFlag
//--------------------------------------------------------------------------
function setGlobalFlag(flag) {
    if(globalFlag == flag) return;
    globalFlag = flag;
    regexp = null;
}
function getGlobalFlag(flag) {
    return globalFlag;
}
//--------------------------------------------------------------------------
//【アクセサ】ignoreCase
//--------------------------------------------------------------------------
function setIgnoreCase(flag) {
    if(ignoreCase == flag) return;
    ignoreCase = flag;
    regexp = null;
}
function getIgnoreCase() {
    return ignoreCase;
}
//--------------------------------------------------------------------------
//【アクセサ】multiLine
//--------------------------------------------------------------------------
function setMultiLine(flag) {
    if(multiLine == flag) return;
    multiLine = flag;
    regexp = null;
}
function getMultiLine() {
    return multiLine;
}
//--------------------------------------------------------------------------
//【アクセサ】pattern
//--------------------------------------------------------------------------
function setPattern(pat) {
    pattern = pat;
    regexp = null;
}
function getPattern() {
    return pattern;
}
//--------------------------------------------------------------------------
//【メソッド】初期化
//--------------------------------------------------------------------------
function initial() {
    if(regexp == null) {
        var flags = '';
        if(globalFlag) flags += 'g';
        if(ignoreCase) flags += 'i';
        if(multiLine)  flags += 'm';
        if(flags == '')
            regexp = new RegExp(pattern);
        else
            regexp = new RegExp(pattern, flags);
    }
    regexp.lastIndex = 0;
}
//--------------------------------------------------------------------------
//【メソッド】Test
//--------------------------------------------------------------------------
function commandTest(str) {
    return regexp.test(str);
}
//--------------------------------------------------------------------------
//【メソッド】Exec
//--------------------------------------------------------------------------
function commandExec(str) {
    var ret = regexp.exec(str);
    if(ret == null) {
        return {
            FirstIndex: -1,
            Length: -1,
            Value: '',
            SubMatches: []
        };
    } else {
        return {
            FirstIndex: ret.index,
            Length: ret[0].length,
            Value: ret[0],
            SubMatches: ret.slice(1)
        };
    }
}
//--------------------------------------------------------------------------
//【メソッド】Replace
//--------------------------------------------------------------------------
function commandReplace(str, rep) {
    return str.replace(regexp, rep);
}

VBA コード

VBA コードのうち，メソッド$\texttt{Test()}$は JScript のメソッド$\texttt{test()}$をほぼそのまま呼び出す。なお$\texttt{initial()}$は$\texttt{RegExp}$コンストラクタの呼び出しおよび$\texttt{lastIndex}$のゼロクリアを行う。

RegExp2.cls の Test メソッド
Public Function Test(str As String) As Boolean
    CallByName oScriptControl.CodeObject, "initial", vbMethod
    Test = CallByName(oScriptControl.CodeObject, "commandTest", vbMethod, str)
End Function

メソッド$\texttt{Replace()}$も同様に JScript のメソッド$\texttt{replace()}$をほぼそのまま呼び出す。$\texttt{initial()}$の呼び出しも同様である。

RegExp2.cls の 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

メソッド$\texttt{Execute()}$は JScript のメソッド$\texttt{exec()}$を繰り返し呼び出してコレクションに追加していく。$\texttt{FirstIndex}$が負の値であれば終了とするようにした。$\texttt{GlobalFlag}$が無効のときは$\texttt{Do}$ループを一回で終了する。

RegExp2.cls の 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

コレクション

VBA の正規表現では$\texttt{MatchCollection}$と$\texttt{SubMatches}$という二つのコレクションを取り扱う。VBA の組み込みクラスである$\texttt{Collection}$のラッパーとして実装したいが，これら二つのコレクションは 0-origin なのに対し，$\texttt{Collection}$は 1-origin なので注意する必要がある。

$\texttt{MatchCollection}$は$\texttt{Match}$オブジェクトのコレクション，$\texttt{SubMatches}$は文字列のコレクションなのでどちらもほぼ同じコードである。一例として$\texttt{SubMatches}$の実装コードを以下に示す。

  • 0-origin にするためアクセサ$\texttt{Item}$で参照する際にインデクスを一つずらす。
  • アクセサ$\texttt{Item}$を既定のプロパティにするため，$\texttt{Attribute}$属性を定義する。この属性は VBA エディタで編集できないので，いったんテキストファイルにエクスポートした後，テキストエディタで編集したものを再度インポートする必要がある。
  • コレクションはループカウンタを用いたインデクス参照以外にも$\texttt{For Each}$ループを用いて各要素を順に参照することができる。これを可能とするのがアクセサ$\texttt{NewEnum}$である。こちらも$\texttt{Attribute}$属性を定義する必要がある。VBA エディタで編集できないのも同じ。
  • $\texttt{MatchCollection}$と$\texttt{SubMatches}$は本来読み出し専用であるため，$\texttt{Add}$メソッドが見えてはいけないと思うが，VBA の組み込みクラスである$\texttt{Collection}$のラッパーとして作っている以上，完全な隠蔽は難しい。
SubMatch2.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

ScriptControl が返す変数の型について

JScript コードを ScriptControl で呼び出した際，返値の変数の型が悩ましい。受け取る変数の型が決まっていればその型で受け取ればよいし，スカラー変数であれば$\texttt{Variant}$型にしてもよい。$\texttt{Variant}$型は$\texttt{null}$を受け取ることもできる。ただし，$\texttt{Variant}$型で配列やオブジェクトを受け取ると単なる文字列になってしまい，その後の処理に困ることになる。

配列やオブジェクトを受け取ろうとしたら$\texttt{Object}$型にする必要があるが，逆にスカラー変数を受け取ろうとするとエラーになる。

表３　ScriptControl の返値の型
JavaScript 側の返値 VBA 側で受け取る変数型
Variant Object
$\texttt{null}$ $\texttt{Null}$ エラー
$\texttt{true}$ $\texttt{Boolean}$ エラー
$\texttt{100}$ $\texttt{Long}$ エラー
$\texttt{123.4}$ $\texttt{Double}$ エラー
$\texttt{'string'}$ $\texttt{String}$ エラー
$\texttt{[10, 20]}$ $\texttt{String}$ $\texttt{JScriptTypeInfo}$
$\texttt{{x:10, y:20}}$ $\texttt{String}$ $\texttt{JScriptTypeInfo}$

上記の結果を確認するため作成したテストコードである。

テストコード
Sub TEST_TYPE()
    Dim oSC As New ScriptControl
    Dim str As String
    Dim var As Variant
    Dim obj As Object
    Dim i   As Long
    str = str & vbCrLf & "function func(n) {"
    str = str & vbCrLf & "   if(n == 0) return null;"
    str = str & vbCrLf & "   if(n == 1) return true;"
    str = str & vbCrLf & "   if(n == 2) return 100;"
    str = str & vbCrLf & "   if(n == 3) return 123.4;"
    str = str & vbCrLf & "   if(n == 4) return 'string';"
    str = str & vbCrLf & "   if(n == 5) return [10, 20];"
    str = str & vbCrLf & "   if(n == 6) return {x:10, y:20};"
    str = str & vbCrLf & "}"
    oSC.Language = "JScript"
    oSC.AddCode str
    For i = 0 To 6
        var = CallByName(oSC.CodeObject, "func", VbMethod, i)
        MsgBox "型名：" & TypeName(var) & vbCrLf & "値：" & var
    Next
    On Error Resume Next
    For i = 0 To 6
        Set obj = CallByName(oSC.CodeObject, "func", VbMethod, i)
        If Err.Number <> 0 Then
            MsgBox Err.Description
            Err.Clear
        Else
            MsgBox "型名：" & TypeName(obj) & vbCrLf & "値：" & obj
        End If
    Next
End Sub

配列のサイズ$\texttt{length}$や各要素は，受け取った$\texttt{Object}$型の変数$\texttt{obj}$を用いて参照できる。

Sub TEST_ARRAY
    Dim oSC As New ScriptControl
    Dim obj As Object
    Dim i   As Long
    Dim n   As Long
    oSC.Language = "JScript"
    oSC.AddCode "function func() { return [10, 20]; }"
    Set obj = CallByName(oSC, "func", vbMethod)
    n = CallByName(obj, "length", vbGet)
    For i = 0 To n - 1
        MsgBox CallByName(obj, i, vbGet)
    Next
End Sub

オブジェクトに対しても同様である。

Sub TEST_OBJECT
    Dim oSC As New ScriptControl
    Dim obj As Object
    oSC.Language = "JScript"
    oSC.AddCode "function func() { return {x:10, y:20}; }"
    Set obj = CallByName(oSC, "func", vbMethod)
    MsgBox CallByName(obj, "x", vbGet)
    MsgBox CallByName(obj, "y", vbGet)
End Sub

参考文献

0
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
0
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?