文字列操作・正規表現 | エクセルマクロ(VBA)実践蔵(じっせんぐら)

エクセルマクロ(VBA)で正規表現を使用するならregExpオブジェクトを使用することになります。regExpオブジェクトは、Visual Basic Editor画面のツール「参照設定」にて「Microsoft VBScript Regular Expressions5.5」にチェックを入れる必要があります。

regExpオブジェクトでできること

存在するかしないかを調べる検索

検索文字列に含まれる文字列を探す(InStr)や完全に一致する文字列であるかを確認する(StrComp)、そのどちらの機能も使えます。

正規表現において、完全一致を求める場合は、文字列の先頭を表す記号^と文字列の末尾を表す記号$で、検索したい文字列を挟みます。

部分一致は、検索したい文字列の正規表現文字列をそのまま使用します。

regExpオブジェクトのtest関数を呼び出すと、存在するかしないかの答えを返してくれます。

下記に用意した関数は、RegExpオブジェクトを使用して、InStrとStrCompの役割を持たせた正規表現版を作成してみました。

 
' 第1引数 text が検索対象文字列 
' 第2引数 format が 正規表現を含む検索したい文字列 
' 第3引数 pattern がtrueなら第1引数textと第2引数formatが完全に一致するかの確認。 
' 第3引数 pattern がFalseなら第1引数textに第2引数formatが含まれるかの確認。      
' 正規表現メモ：1桁の数字表現が\d 
'               桁数固定の数字なら\d\d\dと必要桁数分並べる 
'               数字が何桁でもよいなら\d+ 
'               アルファベット大文字小文字含む1文字なら[a-zA-Z] 
Function RExp_inStrComp(text As String, format As String, pattern As Boolean) As Boolean   
    Dim RegExpObj As regExp 
     
    Set RegExpObj = CreateObject("VBScript.RegExp") 
     
    '全角/半角の区別 False(区別する)/True(区別しない) 
    '2024/06/02 バグ対応 全角/半角の区別の記述が逆になっていたので訂正 
    RegExpObj.IgnoreCase = False 
    '適応個所 True(すべて)/False(一致する先頭の一つが対象) 
    RegExpObj.Global = True  
     
    '探す文字列（検索フォーマット）         
    If pattern = True Then 
    '完全一致 
        RegExpObj.Pattern = "^" & format & "$" 
    Else 
        RegExpObj.Pattern = format 
    End if 
     
    '結果を返す 
    RExp_inStrComp = RegExpObj.test(text) 
     
    Set RegExpObj = Nothing 
End Function

上記関数の呼び出し例：

 
Sub test() 
    Dim result As Boolean 
    '部分一致確認検索 
    result = RExp_inStrComp("今日の日付は、2019年7月12日です。", _ 
                             "\d+月\d+日", False) 
 
    Debug.Print result 'trueになる 
     
End Sub

検索数：一致する個所が何か所あるか確認する

 
' ******************************************************** 
'  一致数を調べる正規表現文字列検索 
'  第1引数 text に 第2引数 formatと一致する回数を戻り値で返す 
'  formatは、正規表現で表す。(見つからない場合0が戻る) 
' ******************************************************** 
Function RExp_FindCount(ByRef text As String, ByRef format As String) As Long 
     
    Dim RegExpObj As regExp 
    Dim findList As MatchCollection 
    Dim findItem As Match 
    Dim cnt As Long 
     
    Set RegExpObj = CreateObject("VBScript.RegExp") 
     
    '正規表現検索の初期値設定 
    '2024/06/02 バグ対応 全角/半角の区別の記述が逆になっていたので訂正 
    RegExpObj.IgnoreCase = False '全角半角区別 
    RegExpObj.Global = True     'すべて探す 
    RegExpObj.pattern = format  '見つけるフォーマット 
     
    Set findList = RegExpObj.Execute(text) 
     
    RExp_FindCount = findList.Count 
End Function

上記関数の呼び出し例：

 
Sub testRExp_FindCount() 
    Dim result As Integer 
     
    result = RExp_FindCount("今日の日付は、2019年7月12日です。", _ 
                             "\d+") 
 
    Debug.Print result '3になる 
     
End Sub

文字列の抽出：一致する個所の文字列配列を返す

複数個所の一致に対応していますが、もちろん、1か所の一致から使えます。

下記の関数一つで、見つけた場所が、1か所でも複数でも、対処できます。

regExpオブジェクトを使用する関数で作成しておくと、regExpオブジェクトの使い方を調べる手間が減ります。

 
' ******************************************************** 
'  一致箇所をリストで求める正規表現文字列検索 
'  第1引数 textの文字列から第2引数 formatと一致する文字列リストを返す 
'  第2引数 format は、正規表現で表す。 
'  第3引数 returnlist() が配列で、一致文字列リストが返る 
'  見つかった数を戻り値で返す。(見つからない場合0が戻る) 
' ******************************************************** 
Function RExp_FindStrArr(ByRef text As String, ByRef format As String, _ 
                    ByRef returnlist() As String) As Long 
     
    Dim RegExpObj As regExp 
    Dim findList As MatchCollection 
    Dim findItem As Match 
    Dim cnt As Long 
     
    Set RegExpObj = CreateObject("VBScript.RegExp") 
     
    '正規表現検索の初期値設定 
    '2024/06/02 バグ対応 全角/半角の区別の記述が逆になっていたので訂正 
    RegExpObj.IgnoreCase = False 
    RegExpObj.Global = True 
    RegExpObj.pattern = format 
     
    'まずは、一致数を調べる 
    Set findList = RegExpObj.Execute(text) 
     
    If findList.Count = 0 Then 
        RExp_FindStrArr = 0 
        Exit Function 
    End If 
     
    '一致数 findList.Count数分の配列を準備  
    '配列の添え字を0番から使用するため、必要配列数は1を引く([0]から埋める) 
    ReDim returnlist(findList.Count - 1) 
 
    '配列に格納する 
    cnt = 0 
    For Each findItem In findList 
        returnlist(cnt) = findItem.value 
        cnt = cnt + 1 
    Next 
    '一致数を返す 
    RExp_FindStrArr = findList.Count 
 
End Function

上記関数の呼び出し例：

 
Sub testRExp_FindStrArr() 
    Dim result As Integer 
    Dim strlist() as String 
    Dim cnt as Long 
     
    result = RExp_FindStrArr("今日の日付は、2019年7月12日です。", _ 
                             "\d+",strlist) 
     
    Debug.Print result 
    For cnt = LBound(strlist) to UBound(strlist) 
        Debug.Print "[" & cnt & "]:" & strlist(cnt)  
    Next 
 
End Sub 
 
'結果 
'3 
'[0]:2019 
'[1]:7 
'[2]:12

置換：正規表現を使用してのReplace。一か所又は、全置換

 
Function RExp_Replace(text As String, format As String, chgtext As String, all_flg As Boolean) As String 
 
    Dim RegExpObj As regExp 
     
    On Error GoTo FuncEnd 
    Set RegExpObj = CreateObject("VBScript.RegExp") 
     
    '全角/半角の区別 
    '2024/06/02 バグ対応 全角/半角の区別の記述が逆になっていたので訂正 
    RegExpObj.IgnoreCase = False 
    '適応個所 (引数に従う) 
    RegExpObj.Global = all_flg 
    '適応個所 (引数に従う) 
    RegExpObj.pattern = format 
     
    RExp_Replace = RegExpObj.Replace(text, chgtext) 
   
  Exit Function 
   
FuncEnd: 
       
      Debug.Print "フォーマットを見直してください。正規表現の記号の使い方に問題がありそうです。" 
       
End Function

上記関数の使い方例を下記に記載します。

 
Sub testReplace() 
    Dim beforeText as String 
    Dim afterText As String 
     
    beforeText = "今日の日付は、2019年7月12日です。" & vbCrLf & "明日は13日です。" 
 
    afterText = RExp_Replace(beforeText, _ 
                             vbCrLf & ".+。$", _ 
                             vbCrLf & "明日は土曜日です。", _ 
                             False) 
                             '改行コードから末尾までの文章を差し替える 
                              
                             '検索文字列：vbCrLf & ".+。$" 
                             '置換文字列：vbCrLf & "明日は土曜日です。" 
                              
    Debug.Print "置換前：" & beforeText & vbCrLf 
    Debug.Print "置換後：" & afterText 
 
End Sub 
 
'結果 
'置換前：今日の日付は、2019年7月12日です。 
'明日は13日です。 
 
'置換後：今日の日付は、2019年7月12日です。 
'明日は土曜日です。

検索に使用している正規表現（フォーマット）の".+"は文字列なんでも可という意味になります。そこに"。"（文の末尾を表す句点のまる）を組み合わせると一文の検索になります。最後に$マークをつけると、文章の末端になるため、一番末尾の一文が該当します。

あとは、他の関数とも組み合わせていくことで、できることが増えます。

regExpオブジェクトとsplitを組み合わせる

取り出して、編集(変換)して、差し戻す

RExp_FindStrArr()を使用して取り出し、編集を加えて、同じ個所を下記のRExp_ReplaceArr()で差し替えます。

 
' ******************************************************** 
'  第一引数のtextに含まれる正規表現のformatと一致する個所を 
'  配列chgtextの文字列で置き換えて、差し替えた文字列を戻す 
' ******************************************************** 
Function RExp_ReplaceArr(text As String, format As String, chgtext() As String) As String 
     
    Dim split_str() As String 
    Dim temp As String 
     
    RExp_ReplaceArr = "" 
    '差し戻す 代入箇所にデリミタを挿入(文章内に登場しない文字列[&%$] 
    temp = RExp_Replace(text, format, "&%$", True) 
    split_str = Split(temp, "&%$", , vbBinaryCompare) 
     
    '文字列の連結 
    For cnt = LBound(chgtext) To UBound(chgtext) 
        If cnt > UBound(split_str) Then '配列要素範囲外 
            Exit For '異常発生：範囲外のアクセスをしない 
        End If 
        RExp_ReplaceArr = RExp_ReplaceArr & split_str(cnt) & chgtext(cnt) 
    Next 
    If cnt < UBound(split_str) + 1 Then '配列要素範囲内 
        RExp_ReplaceArr = RExp_ReplaceArr & split_str(cnt) 
    End If 
     
End Function

例：西暦を取り出して、元号に変換して、元の位置に戻す。

 
Sub testRExp_ReplaceArr() 
 
    Dim beforeText As String 
    Dim afterText As String 
    Dim strlist() As String 
    Dim chgtext() As String 
    Dim yearInt As Long 
    Dim cnt As Long 
     
    beforeText = "今日の日付は、2019年7月12日です。" & vbCrLf & "来年は2020年でオリンピックの年です。" 
     
    '一致する文字列をstrlist()に取り出す 
    result = RExp_FindStrArr(beforeText, "\d+年", strlist) 
    ReDim chgtext(result - 1) 
     
    '一致する個所 strlist()数分ループ 
    For cnt = LBound(strlist) To UBound(strlist) 
        ' 年を削除 
        chgtext(cnt) = Replace(strlist(cnt), "年", "", , , vbTextCompare) 
        '数字のみになったか確認 
        If IsNumeric(chgtext(cnt)) = True Then 
            yearInt = val(chgtext(cnt))       '文字列から数値に変換 
             
            '元号に変換処置 
            yearInt = yearInt - 2019 
            If yearInt = 0 Then 
                chgtext(cnt) = "令和元年" 
            ElseIf yearInt > 0 Then 
                chgtext(cnt) = "令和" & yearInt & "年" 
            End If 
        End If 
    Next 
     
    '変更した文字列に差し替える 
    afterText = RExp_ReplaceArr(beforeText, "\d+年", chgtext) 
    Debug.Print "置換前：" & beforeText & vbCrLf 
    Debug.Print "置換後：" & afterText 
 
End Sub 
 
'実行結果 
'置換前：今日の日付は、2019年7月12日です。 
'来年は2020年でオリンピックの年です。 
 
'置換後：今日の日付は、令和元年7月12日です。 
'来年は令和1年でオリンピックの年です。

splitと組み合わせることで、任意の個所を修正して、差し戻すことが可能になります。

全角を半角に変更する場合は、標準関数でStrConvが用意されていますので、取り出した文字列をループ内で変換して、同じようにRExp_ReplaceArrを使用して、差し替えることができます。

正規表現として使用される記号の検索

ドット(.)やスラッシュ(/)といった記号は、正規表現で使用されているため、検索文字列として使用したい場合は、エスケープ記号を付加する必要があります。

コード内で正規表現を用いたフォーマットを作成する場合に、下記を使っています。

 
' ********************************************** 
'  正規表現の記号にエスケープ記号を付加する 
' ********************************************** 
Function SetEscape(ByRef chgStr As String) 
     
    chgStr = Replace(chgStr, "\", "\\", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "*", "\*", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "+", "\+", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, ".", "\.", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "?", "\?", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "{", "\{", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "}", "\}", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "(", "\(", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, ")", "\)", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "[", "\[", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "]", "\]", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "^", "\^", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "$", "\$", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "-", "\-", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "|", "\|", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "/", "\/", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, """", "\""", , , vbBinaryCompare) 
     
End Function

 
 
' ********************************************** 
'  正規表現の記号に付加したエスケープ記号を削除する 
' ********************************************** 
Function DelEscape(ByRef chgStr As String) 
 
    chgStr = Replace(chgStr, "\\", "\", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\*", "*", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\+", "+", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\.", ".", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\?", "?", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\{", "{", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\}", "}", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\(", "(", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\)", ")", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\[", "[", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\]", "]", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\^", "^", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\$", "$", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\-", "-", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\|", "|", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\/", "/", , , vbBinaryCompare) 
    chgStr = Replace(chgStr, "\""", """", , , vbBinaryCompare) 
     
End Function

文字列からフォーマットを作成して、同じフォーマットの文字列を探す場合に使用しました。例として、"1234/5/67"と同じフォーマットの文字列を検索します。

 
Sub testEscape() 
     
    Dim Text As String 
    Dim baseFormat As String 
    Dim getFormat As String 
    Dim gettext() As String 
    Dim cnt As Long 
     
    baseFormat = "1234/5/67" '見つけたいフォーマット 
    Text = "今日の日付は、2019/7/12です。" & vbCrLf & "来年は2020年でオリンピックの年です。" 
     
    '文字列からフォーマットを作成する。 
    Call SetEscape(baseFormat) 
    '見つけたいフォーマットの数値を\dに変換 
    getFormat = RExp_Replace(baseFormat, "\d", "\d", True) 
     
    Debug.Print getFormat 
     
    cnt = RExp_FindStrArr(Text, getFormat, gettext) 
    For cnt = LBound(gettext) To UBound(gettext) 
            Debug.Print gettext(cnt) 
    Next 
End Sub 
 
'実行結果 
'\d\d\d\d\/\d\/\d\d 
'2019/7/12

regExpオブジェクトとinStrにある検索開始を組み合わせる

下記の記事は、正規表現検索を行い、セル内で該当する部分の文字列の色やスタイルを変更するマクロになります。下記で使用した、正規表現を使用した関数をこちらにもあげておきます。

標準関数inStrは引数に、検索開始位置を指定できます。これと同じ機能を持たせて、正規表現検索を行う関数を作成しました。

関連記事
文字色とスタイルの変更マクロ

検索開始位置を指定して、正規表現文字列検索を行い一致した先頭の文字列のみを返す

 
'***************************************************** 
'一致する文字列の先頭(一つ目)の文字列を返す 
'引数 pos : 検索開始位置 
'引数 text : 検索対象文字列 
'引数 format : 正規表現検索文字列 
'***************************************************** 
Function RExp_FindStr(pos As Long, Text As String, format As String) As String 
     
    Dim returnlist() As String 
    Dim getstr As String 
     
     
    If RExp_FindCount(Text, format, pos) > 0 Then 
     
        getstr = Right(Text, Len(Text) - (pos - 1)) 
         
        Call RExp_FindStrArr(getstr, format, returnlist) 
         
        RExp_FindStr = returnlist(0) 
         
    Else 
         
        RExp_FindStr = "" 
    End If 
     
End Function

上で呼び出しているRExp_FindCountは、下記に記載します。RExp_FindStrArrは記載済みです。

検索開始位置を指定して、正規表現文字列検索を行い一致数を返す

 
 
' ******************************************************** 
'  一致数を調べる正規表現文字列検索 
'  第1引数 text に 第2引数 formatと一致する回数を戻り値で返す 
'  formatは、正規表現で表す。(見つからない場合0が戻る) 
'  第3引数 posをオプションで追加。検索開始位置の指定 
' ******************************************************** 
Function RExp_FindCount(ByRef Text As String, ByRef format As String, Optional pos As Long = 1) As Long 
    Dim RegExpObj As RegExp 
    Dim findList As MatchCollection 
    Dim findItem As Match 
    Dim cnt As Long 
      
    Set RegExpObj = CreateObject("VBScript.RegExp") 
      
    '正規表現検索の初期値設定 
    '2024/06/02 バグ対応 全角/半角の区別の記述が逆になっていたので訂正 
    RegExpObj.IgnoreCase = False '全角半角区別 
    RegExpObj.Global = True     'すべて探す 
    RegExpObj.pattern = format  '見つけるフォーマット 
     
    Set findList = RegExpObj.Execute(Right(Text, Len(Text) - (pos - 1))) 
      
    RExp_FindCount = findList.Count 
     
End Function

検索開始位置を指定して、正規表現文字列検索を行い一致開始位置を返す

 
'**************************************************** 
' 一致開始箇所の文字位置を返す 
' 引数 pos : 検索開始位置 
' 引数 text：検索対象文字列 
' 引数 format : 正規表現検索文字列 
'**************************************************** 
Function RExp_InStr(pos As Long, Text As String, format As String) As Long 
     
    Dim temp As String 
     
    '一致する文字列の先頭一か所を取得 
    temp = RExp_FindStr(pos, Text, format) 
     
    If Not temp = "" then  
    	RExp_InStr = InStr(pos, Text, temp, vbTextCompare) 
 
    ElseIf RExp_FindCount(Text, format, pos) > 0 Then 
    'データ無し かつ 検出あり なら 行末検索として対処 
        RExp_InStr = Len(Text) 
 
    Else 
    	RExp_InStr = 0 
    End If 
 
End Function

RExp_FindStrは、この記事に記述済みです。