ヤマ括弧でくくられたテキストを抽出（入れ子）

質問

いつもお世話になっています。VBA学習者です（手短に説明するため文章がぶっきらぼうになることをご容赦ください）。

以下のようなテキストがあったとします。

サンプルテキストA：
test <sample_1> test <sample_2> test.

このテキストから括弧で括られた部分（ここでは「ユニット」と呼びます）を取り出すのは比較的容易です。
しかし、「サンプルテキストB」のように「ユニット」が入れ子になっている場合にも対応する必要があるため以下のコードを書きました。
これでとりあえず、入れ子の一番外殻のユニットを抽出することができました（「結果A」がシートに書き出されます）。

ここから更に、入れ子になっている内側のユニットも取り出したいのですが、これが意外とうまくいきません。
「結果B」のような結果を得るには、どのようにしたらよいでしょうか。

必ずしも、下に示した処理方法にこだわるものではないので、もっと良いアイデアがあれば大歓迎です！

※ここに示したサンプルは1行のみですが、実際には数千行（ユニットがない行も含む）からなるファイルをいくつも連続して処理するので、出来るだけシンプルに高速で処理できるようにしたいと思っています。

サンプルテキストB：
Test <if([control],<if([control],<if([test],a,b)>,c)>,<if([control],d,e)>> test <if([control],<if([control],f,g)>,<if([control],h,i)>><if([control],j,k)>.

結果A：
<if([control],<if([control],<if([test],a,b)>,c)>,<if([control],d,e)>>
<if([control],<if([control],f,g)>,<if([control],h,i)>>
<if([control],j,k)>

結果B：
<if([control],<if([control],<if([test],a,b)>,c)>,<if([control],d,e)>>
<if([control],<if([control],f,g)>,<if([control],h,i)>>
<if([control],j,k)>
<if([control],<if([test],a,b)>,c)>
<if([test],a,b)>
<if([control],d,e)>
<if([control],f,g)>
<if([control],h,i)>

Sub テスト()

Dim i As Long
Dim j As Long

'テキストファイル内の行を格納する変数
Dim textLine As String

'テキストの文字数を格納
Dim letterCount As Integer

'ヤマ括弧の数を数えるカウンタ用
Dim bracketCounter1 As Integer
Dim bracketCounter2 As Integer

'括弧の位置を格納する変数
Dim bracketPosition1 As Integer
Dim bracketPosition2 As Integer

'「<」から「>」までのテキストを格納
Dim textFromToBracket As String

'括弧の見つかった位置を格納する配列
Dim unitArray() As String

'bracketArray1()の要素数のカウンタ
Dim inArrayCounter As Integer

'textLineにテスト用テキストを格納
textLine = "Test <if([control],<if([control],<if([test],a,b)>,c)>,<if([control],d,e)>> test <if([control],<if([control],f,g)>,<if([control],h,i)>><if([control],j,k)>."

letterCount = Len(textLine)

'先頭から「< 」と「>」 をカウントし、の数が一致したところが1ユニット
For i = 1 To letterCount
'Midで1文字ずつとりだしつつ「<」を検索
If Mid(textLine, i, 1) = "<" Then
bracketCounter1 = bracketCounter1 + 1
'1つ目の「<」の位置を格納
If bracketCounter1 = 1 Then
bracketPosition1 = i
End If
End If

'Midで1文字ずつとりだしつつ「>」を検索
If Mid(textLine, i, 1) = ">" Then
bracketCounter2 = bracketCounter2 + 1
End If

'ヤマ括弧の数が0以外で、括弧始め／閉じの数が一致したら
If bracketCounter1 + bracketCounter2 > 0 And bracketCounter1 = bracketCounter2 Then
'その時点の「>」の位置を格納
bracketPosition2 = i

'bracketPosition1からbracketPosition2までのテキストを切り出し
textFromToBracket = Mid(textLine, bracketPosition1, bracketPosition2 - bracketPosition1 + 1)

'配列の要素数を1つずつ増やしながらユニットを格納
inArrayCounter = inArrayCounter + 1
ReDim Preserve unitArray(inArrayCounter)
unitArray(inArrayCounter) = textFromToBracket

'bracketCounter1とbracketCounter2を初期化
bracketCounter1 = 0
bracketCounter2 = 0
End If
Next

'以下配列に格納したユニットを書き込み
For j = 1 To UBound(unitArray)
Cells(j, 1).Value = unitArray(j)
Next j

End Sub

回答No.2

nda23 · ベストアンサー

完全に内側の部分のタグを抜き出すなら
正規表現を組み合わせて処理できます。

Dim 原始テキスト As String
Dim 行位置 As Long
Dim カッコ内を抜き出す As Object
Dim 左カッコを数える As Object
Dim 左カッコを置換する As Object
Dim 一致集団 As Object
Dim 部分一致 As Object
Dim 左カッコ集団 As Object
Dim 左カッコ数 As Long
Dim カウンタ As Long
Dim 一致文字列 As String
Dim 正規表現 As String

原始テキスト = "Test <if([control]～" '★略
行位置 = 0
'★カッコ内を抜き出す正規表現を作る
Set カッコ内を抜き出す = CreateObject("VBScript.RegExp")
カッコ内を抜き出す.Global = True
カッコ内を抜き出す.Pattern = "(<.*?>)"
'★左カッコを数える正規表現を作る
Set 左カッコを数える = CreateObject("VBScript.RegExp")
左カッコを数える.Global = True
左カッコを数える.Pattern = "<"
'★左カッコを置換する正規表現を作る
Set 左カッコを置換する = CreateObject("VBScript.RegExp")
左カッコを置換する.Global = False
'★カッコ内を抜き出して一致集合を作る
Set 一致集団 = カッコ内を抜き出す.Execute(原始テキスト)
'★集合の一つずつを順に処理する
For Each 部分一致 In 一致集団
　　　　'★一致した文字列を取得する
　　　　一致文字列 = 部分一致.Value
　　　　'★一致した文字列の中の左カッコの数を調べる
　　　　Set 左カッコ集団 = 左カッコを数える.Execute(一致文字列)
　　　　If 左カッコ集団.Count > 1 Then
　　　　　　　　'★左カッコが2個以上の場合は直前の左カッコまで除去する
　　　　　　　　正規表現 = ""
　　　　　　　　'★左カッコの数-1だけ下記パターンを繋げる
　　　　　　　　For カウンタ = 2 To 左カッコ集団.Count
　　　　　　　　　　　　正規表現 = 正規表現 & "<.*?"
　　　　　　　　Next
　　　　　　　　'★最後の左カッコを追加する
　　　　　　　　左カッコを置換する.Pattern = 正規表現 & "<"
　　　　　　　　'★最初の左カッコから最後の左カッコまでを一つの左カッコにする
　　　　　　　　一致文字列 = 左カッコを置換する.Replace(一致文字列, "<")
　　　　End If
　　　　'★行位置を更新して結果をセルに記録する
　　　　行位置 = 行位置 + 1
　　　　Cells(行位置, 1) = 一致文字列
Next

特定のパターンを抜き出したり置換するのに正規表現は便利です。
文字を数えるのも楽ですしね。
正規表現がどんな働きをするかデバッグ実行で１ステップずつ
実行してみてください。

お礼

早速のご回答ありがとうございます！

実は、私も当初は正規表現での処理を試みていたのですが、nda23が活用されていた正規表現でヒットした文字列のコレクション（？）の存在や、正規表現のパターンを動的に変化させる手法を知らなかったために挫折したのでした。

私が書いたコードで外殻の「ユニット」を取り出した上で、nda23さんにご教授いただいたプロシージャをCallで呼べば「結果B」が得られそうです。

意図した結果が得られただけなく、今後の正規表現を使用した処理の可能性も広がりました。
ありがとうございました。

回答No.3

nda23

#2です。
VBAという範疇から少しズレますが、JavaScriptの
Stringオブジェクトを使う方法を思い出したので、
参考までに記載します。これで期待する結果になる
のではないでしょうか。
JavaScriptの/～/は正規表現です。

Function 解析(ByVal 文字列 As String) As String()
Dim JS As ScriptControl
Dim X As Long
Dim I As Long
Dim 文 As String
'★オブジェクトの生成
Set JS = CreateObject("ScriptControl")
JS.Language = "JavaScript"
'★共通変数の定義
JS.ExecuteStatement "var 配列 = new Array();"
JS.ExecuteStatement "var 多重度 = 0;"
JS.ExecuteStatement "var カッコ数 = 0;"
JS.ExecuteStatement "var カッコ位置 = 0;"
JS.ExecuteStatement "var 文字列 = '';"
'★解析関数の定義
文 = "function 解析(文字,位置) {"
'●左カッコで一致した場合
文 = 文 & vbNewLine & "if ( 文字 == '<' ) {"
'●最初のカッコの場合は位置を記録する
文 = 文 & vbNewLine & " if ( カッコ数 == 0 ) カッコ位置 = 位置;"
'●カッコのネストレベルを増加させる
文 = 文 & vbNewLine & " カッコ数++;"
文 = 文 & vbNewLine & " return;"
文 = 文 & vbNewLine & "}"
'■右カッコで一致したらネストレベルを減少させる
文 = 文 & vbNewLine & "カッコ数--;"
'■ネストレベルが0に戻らない場合は何もしない
文 = 文 & vbNewLine & "if ( カッコ数 != 0 ) return;"
'■右カッコの数が揃ったので、部分列を取得する
文 = 文 & vbNewLine & "var 部分文字列 = 文字列.substring(カッコ位置,位置 + 1);"
'■多重度文字列の字数を得る
文 = 文 & vbNewLine & "var 字数 = (多重度 + '').length;"
'■現在の多重度以下をスキップする
文 = 文 & vbNewLine & "var i = 0;"
文 = 文 & vbNewLine & "for ( ; i < 配列.length ; i++ ) {"
文 = 文 & vbNewLine & " if ( 多重度 < 配列[i].substr(0,字数).valueOf() ) break;"
文 = 文 & vbNewLine & "}"
'■配列の要素数を増やす
文 = 文 & vbNewLine & "配列.length++;"
'■配列をズラせる
文 = 文 & vbNewLine & "for ( var j = 配列.length - 1 ; j > i ; j-- ) {"
文 = 文 & vbNewLine & " 配列[j] = 配列[j - 1];"
文 = 文 & vbNewLine & "}"
'■レベルと一緒に部分列を格納する
文 = 文 & vbNewLine & "配列[i] = 多重度 + 部分文字列;"
'■部分列内部の左カッコ数が1なら終了する
文 = 文 & vbNewLine & "if ( 部分文字列.match(/</g).length == 1 ) return;"
'■現在の情報を記録する
文 = 文 & vbNewLine & "var 保存数 = カッコ数;"
文 = 文 & vbNewLine & "var 保存位置 = カッコ位置;"
文 = 文 & vbNewLine & "var 保存文字列 = 文字列;"
'■共通変数を初期化する
文 = 文 & vbNewLine & "カッコ数 = 0;"
文 = 文 & vbNewLine & "カッコ位置 = 0;"
'■多重度を増加させる
文 = 文 & vbNewLine & "多重度++;"
'■先頭の左カッコを除いた文字列を解析する
文 = 文 & vbNewLine & "文字列 = 部分文字列.substr(1);"
文 = 文 & vbNewLine & "文字列.replace(/<|>/g,解析);"
'■多重度を減少させる
文 = 文 & vbNewLine & "多重度--;"
'■共通変数を戻す
文 = 文 & vbNewLine & "カッコ数 = 保存数;"
文 = 文 & vbNewLine & "カッコ位置 = 保存位置;"
文 = 文 & vbNewLine & "文字列 = 保存文字列;"
'★解析関数の終端
文 = 文 & vbNewLine & "}"
JS.ExecuteStatement 文
文 = ""
'◎文字列を代入
JS.ExecuteStatement "文字列 = '" & ThisWorkbook.Worksheets(1).Cells(1, 1) & "';"
'◎文字列を解析
JS.ExecuteStatement "文字列.replace(/<|>/g,解析);"
'◎配列の要素数を取得
X = JS.Eval("配列.length - 1;")
'◎戻り値用配列を定義する
ReDim 配列(X) As String
'◎結果を設定する
For I = 0 To X
配列(I) = JS.Eval("配列[" & CStr(I) & "].replace(/\d+/,'')")
Next
'★オブジェクトを解放する
JS.Reset
Set JS = Nothing
'◎戻り値を返す
解析 = 配列
End Function

JavaScriptのStringオブジェクトにはreplaceメソッドがありますが、
このメソッドの第2パラメータに関数を指定すると、正規表現が
一致した文字と一致した位置をパラメータにして呼び出します。
正規表現は"<"または">"としています。
<>が揃ったところで、内側の解析を順次、実行しています。
配列は外側の<>から内側の<>と、ネストレベルが下がるほど
後方になるように並べ替えています。

お礼

お礼が遅くなってしまいました。申し訳ありません。

やっぱり、VBAだけじゃなくて他の言語もしっていると便利ですね。
ちょうど、PHPとかJAVAのようなWave系で使われる言語もちょっと知っときたいなぁ、と思っていたところです。
お陰さまで、モチベーションがちょっとあがりました。

でも、プログラミング言語だけじゃなくて外国語にも手を出しているので、JAVAの勉強はいつになることやら。。。

とにかく、ご教示ありがとうございました。
勉強になりました。

回答No.1

kmee

こういうのは、一つのsubやfunctionで全部やろうとしないで、1部だけ分解するsub/functionを何度も適用するのがいいと思います。

例えば
> Sub テスト()
→ sub 分解(testLine as string)
等として、
分解 サンプルテキストB
で分解して、結果Aが得られたら、
分解 Cells(1,1).Value
で 結果Aの1つめをさらに分解して....と分解できなくなるまで繰り返す、というものです。

そのままだと、セルが上書きされるとか、分解できない場合の判定とかができないので、いろいろと工夫が必要ですが。
functionにして、結果のunitArray()をそのまま返すとか、終了時の最後のセルの場所を返すとか。

補足

早速のご回答ありがとうございます。

実は、私も実際に文字列を抽出する処理はサブルーチンにして、繰り返し呼び出せばいいじゃないかと思っていたのですが、「入れ子がなくなるまで」の判定をどうしようとか、サブルーチンの戻り値をどう配列に入れたらいいだろう、というところで良くわからなくなり挫折したのでした。

＞functionにして、結果のunitArray()をそのまま返すとか、

Functionプロシージャって配列を戻り値と出来るんですか？
手元の書籍にはやり方が書いてないのですが、よろしかったらちょっと教えていただけませんか？