文字列の抽出と計算　３．VBA：パターンに着目する ①

はじめに
今回のテーマ
パターンに着目した文字の抽出
おわりに
- メリット　：
- デメリット：

はじめに

前回は、半角スペースと「_」が混在する場合に対応しました。
infoment.hatenablog.com

今回も、前回の内容を改良してみましょう。

今回のテーマ

前回と同じテーマです。
一つのセルに、３桁の数字が３つあります。これらは、半角スペースで区切られています。この数字について、真ん中のグループの和を求めてみましょう。
f:id:Infoment:20180619063141p:plain

パターンに着目した文字の抽出

数字３文字＋半角スペース１文字＋数字３文字・・・・のように、入力者全員がルールを守り規則正しく入力していれば、そもそもマクロを使う必要はありません。ワークシート関数で充分です。

しかし全く同じ内容であっても、人によって入力結果の表現が微妙に違う場合があって、その全てにワークシート関数で対応するのは、とても難しいことです。
（式が恐ろしく煩雑になり、複雑怪奇化する恐れがあります）。

そこで今回は、さまざまな状況を想定したパターンを予め作成しておき、そのパターンにマッチするか否かで確認する方法を採ってみます。この手法は、「正規表現」と呼ばれています。

それではまず、入力ルール皆無の無法地帯をみてみましょう。

f:id:Infoment:20180627182816p:plain

これはもう、一つずつ置換するよりも、一気にやっつけてしまいましょう。
まず、下ごしらえです。「ツール」の「参照設定」を選択します。

f:id:Infoment:20180627210923p:plain

この中にある、「Microsoft VBScript Regular Expressions 5.5」にチェックを入れ、ＯＫボタンを押します（※この操作は、ブック単位で初回のみです）。

f:id:Infoment:20180627211005p:plain

今回は、次のようにコードを変更しました。

Sub myCalc()

    Dim i As Long
    Dim iMax As Long
    Dim str As String
    Dim myReg As New RegExp
    Dim matchCase As MatchCollection
    Dim subMatche As SubMatches
    
' 最終行番号の取得
    iMax = Cells(Rows.Count, 1).End(xlUp).Row - 1

' 正規表現のパターン定義
    myReg.Pattern = "(^\d+)[\s_･と](\d+)[\s_･と](\d+)"

' 合計セルの初期化
    Cells(iMax + 1, 2) = 0

' 各行の値抽出と足し算
    For i = 2 To iMax
        str = StrConv(Cells(i, 1), vbNarrow)
        If myReg.test(str) = True Then
            Set matchCase = myReg.Execute(str)
            Set subMatche = matchCase(0).SubMatches
            Cells(iMax + 1, 2) = Cells(iMax + 1, 2) + subMatche(1)
        End If
    Next
    
End Sub

今回は、新しい内容がいくつか出てきました。順を追って確認しましょう。

・・・と書いてみて、途中まで長々と解説を書いてみたものの、長すぎて誰も読まないものになってしまいました。今回は説明文を全削除して、コード内にコメントを書くことで説明に代えることにします（＞＜）。

Sub myCalc()

    Dim i As Long
    Dim iMax As Long
    Dim str As String
    Dim myReg As New RegExp ' 正規表現
    Dim matchCase As MatchCollection    ' パターンマッチした文字列格納用コレクション
    Dim subMatche As SubMatches ' matchCase の中の（ ）で括られた部分
    
' 最終行番号の取得
    iMax = Cells(Rows.Count, 1).End(xlUp).Row - 1

' 正規表現のパターン定義
    myReg.Pattern = "(^\d+)[\s_･と](\d+)[\s_･と](\d+)"

' 合計セルの初期化
    Cells(iMax + 1, 2) = 0

' 各行の値抽出と足し算
    For i = 2 To iMax

' 半角と全角が混在するため、一旦全て半角化
        str = StrConv(Cells(i, 1), vbNarrow)

' パターンにマッチする場合、True が返る
        If myReg.test(str) = True Then
        
' パターンマッチした結果を、マッチコレクションに格納する
            Set matchCase = myReg.Execute(str)

' 格納した中身について、（　）で括られた部分を取り出す
            Set subMatche = matchCase(0).SubMatches

' 取り出した結果で足し算
            Cells(iMax + 1, 2) = Cells(iMax + 1, 2) + subMatche(1)
        End If
    Next
    
End Sub