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

はじめに
今回のテーマ
パターンが繰り返されることに着目した文字の抽出
おわりに
- メリット　：
- デメリット：

はじめに

前回は、「正規表現」によるパターンマッチングで、文字を抽出しました。
infoment.hatenablog.com

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

今回のテーマ

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

パターンが繰り返されることに着目した文字の抽出

数字の塊が３つだと分かっていれば、前回のパターンで対応できます。

myReg.Pattern = "(^\d+)[\s_･と](\d+)[\s_･と](\d+)"

入力ルールが崩壊した現場の例。
f:id:Infoment:20180627182816p:plain

しかし以下の場合には、対応できていません。

数字の塊が幾つあるか判らない。
未知の区切り文字に対応できない。

そこで今回、パターンを次のように変更します。
「数字の塊＋数字ではないもの」

さらに、条件に合うものがある限り検索し続けることにします。
コードは以下の通りです。

Sub myCalc()

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

' 正規表現のパターン定義
    myReg.Pattern = "(\d+)\D?"
    
' 正規表現の検索条件　※ひとつ見つけても検索を止めない
    myReg.Global = True

' 合計セルの初期化
    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)

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

myReg.Global = True とすることで、繰り返し検索しています（初期値は False ）。

また、[\s_･と]は、\D? に簡略化しました。
[\s_･と]

\s　半角スペース
_　アンダーバー
･　半角の中黒

_と　平仮名の「と」

\D?

\D　数字以外の全ての文字
?　直前の文字が０回または１回

一番最後の塊は、その後ろに何もないため、「?」としています。
\D? は、\D{0, 1} でも同じ意味です。この {0, 1} は、0～1回という意味になります。

今回のパターンに当てはめると、「123 456 789」は次のようになります。

matchCase(0)=「123 」※半角スペース付き
matchCase(1)=「456 」※半角スペース付き
matchCase(2)=「789」

従って目的の値は 456 は、「matchCase(1).SubMatches(0)」で取り出すことが出来るわけです。

注意点として、数字の塊が１つしかない場合、２つ目の数字を抜き出すよう指示しているのでエラーになります。回避策として、matchCase が２個以上あることを条件に追加する、などがあります。

' 取り出した結果で足し算
            If matchCase.Count >= 2 Then
                Cells(iMax + 1, 2) = Cells(iMax + 1, 2) + matchCase(1).SubMatches(0)
            End If
        End If