t-hom’s diary

主にVBAネタを扱っているブログです。

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

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

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。