Webで動くVBAチュートリアルを作りたい その5

その4で、要素ごとに配列に格納するところまでできたので、これをTextToElemArray関数としてまとめた。

テキストを与えると、要素に分かれた配列を返してくれる関数だ。

 ついでにVBAのモジュールをM1_Main、M2_Sub、M3_Baseの3つに分けて、この関数はM3_Baseに入れることにした。

これで複雑な処理を抽象化し、関数の中に閉じ込めることに成功した。

あとは、TextToElemArrayという関数が最初から存在するかのように、普通の命令と同じように使えば良いだけ。

コードは以下より。

' Module M3_Base
Option Explicit
Function TextToElemArray(ByRef st As String) As String()
    Dim Memory() As String, buf As String, SumLen As String
    ReDim Memory(0): buf = st: SumLen = 0
    
    Do While SumLen < Len(st)
        Dim result As String
        result = FindString(buf)
        SumLen = SumLen + Len(result)
        buf = Mid(st, SumLen + 1)
        If Left(result, 1) = """" Then
            '文字列ならそのまま格納
            Memory(UBound(Memory)) = result
            ReDim Preserve Memory(UBound(Memory) + 1)
        Else
            '文字列以外の場合、スペースでSplitする。
            Dim x As Variant
            For Each x In Split("& + - ) ( * / = , '", " ")
                '演算記号等が他の文字とくっつかないように、あらかじめ前後にスペースを挟む。
                result = Replace(result, x, " " & x & " ")
            Next x
            
            result = Replace(result, vbTab, " ")

            Dim results() As String
            results = Split(result, " ")
            Dim i As Integer
            For i = 0 To UBound(results)
                If Trim(results(i)) <> "" Then
                    '連続スペースはSplitで空要素となるのでこれを無視して
                    '実態のある要素だけをMemory配列に格納
                    Memory(UBound(Memory)) = Trim(results(i))
                    ReDim Preserve Memory(UBound(Memory) + 1)
                End If
            Next
        End If
    Loop
    
    'ひとつMemoryを作りすぎるので、消す
    ReDim Preserve Memory(UBound(Memory) - 1)
    
    TextToElemArray = Memory
End Function

Private Function FindString(ByVal st As String)
    If Left(st, 1) = """" Then
        'ひと文字目が「"」の場合は、
        '次の「"」までの文字を返して終了
        'ただし、「""」と2回続く場合はそのまま検索を継続し、
        'その次の「"」までを返す。
        Dim i As Integer
        For i = 2 To Len(st)
            If Mid(st, i, 1) = """" Then
                If Mid(st, i, 2) = """""" Then
                    i = i + 1
                Else
                    FindString = Left(st, i)
                    Exit Function
                End If
            End If
        Next i
    Else
        'ひと文字目が「"」以外の場合は、
        '次の「"」の手前までの文字を返して終了
        FindString = Split(st, """")(0)
        Exit Function
    End If
    
    '終了条件が見つからなければ、引数をそのまま返す。
    FindString = st
End Function

変数名やロジックはまだまだ改良の余地がありそうだが、ひとまずはフタをしておこうと思う。