VBScriptで中置記法から後置記法(逆ポーランド表記法)への変換

エクセルのVBAで、条件を指定して セルを参照する Range.SpecialCells というメソッドがあるんだけど、
サクッと動作してくれて便利な反面、どうも使い勝手が悪い。
何と言うか、かゆい所に手が届かない。これは VB 全般の特徴とも言えると思う。


例えば、Selection.SpecialCells(xlCellTypeConstants) とすれば
選択範囲の中の定数(Constants)のセルが参照されて、
引数を xlCellTypeFormulas とすれば、数式(Formulas)のセルが参照される。
この引数には一つの値しか指定できないので、
定数のセルと数式のセルの両方(空白でないセル)を参照したい時は、 Union というメソッドとあわせて
Union(Selection.SpecialCells(xlCellTypeConstsnts), Selection.SpecialCells(xlCellTypeFormulas)) と
しないといけない。(実際はエラートラップとかもしないといけない)


もっと単純に、 Selection.SpecialCells(xlCellTypeConstants + xlCellTypeFormulas) としたいところ。
さらにいえば、 xlCellTypeVisible * (xlCellTypeConstants + xlCellTypeFormulas) と指定して、
「定数のセルと数式のセルの両方、ただし、可視セル(フィルタなどで非表示になっていない)のみ」
とかもしたい。


となると、自分で数式の形式で引数を渡すメソッドを作成すれば良いんだけど、
それに先立って、引数の数式を解釈するための仕組みが必要になる。
処理する際は逆ポーランド記法をスタックを使って処理するのが楽だろうから、
いったん普通の数式(中置記法という)を後置記法、逆ポーランド記法に変換する処理が必要になる。


ということで、奥村さんの「C言語による最新アルゴリズム事典」を参考にしながら、
とりあえず VBScript で変換プログラムを作ってみた。


しかし、配列の操作 pop とか push を行うのに自分で関数を書かないといけないって、どうかと思います。
どういう用途で配列を使う事を想定しているんだろうか?


C言語による最新アルゴリズム事典 (ソフトウェアテクノロジー)

C言語による最新アルゴリズム事典 (ソフトウェアテクノロジー)

postfix.vbs

Option Explicit

'# USAGE
Dim expr   : expr = "(a+b)*(c-d)"
Dim infix  : infix = SplitFormula(expr)
Dim postfix: postfix = GetPostfixNotation(infix)

MsgBox s & " => " & Join(postfix, " ")



'# 数式を演算子とオペランドに分割する
Private Function SplitFormula(ByVal s)

    ReDim a(0)
    Dim Literal
    
    s = s & " "
    
    Dim i
    For i = 1 To Len(s)
        Dim c: c = Mid(s, i, 1)
        If InStr(1, "+-*/() ", c) > 0 Then
            If Not Literal = "" Then ArrayPush a, Literal
            If Not c = " " Then ArrayPush a, c
            Literal = ""
        Else
            Literal = Literal & c
        End If
    Next
    
    SplitFormula = a
    
End Function

'# 中置記法を後置記法に変換する
Private Function GetPostfixNotation(ByVal infix)

    ReDim postfix(0)
    Call Expression(infix, postfix)
    GetPostfixNotation = postfix

End Function

Private Sub Factor(ByRef infix, ByRef postfix)

    If HasItem(infix) Then
        If infix(1) = "(" Then
            ArrayShift infix
            Call Expression(infix, postfix)
            If HasItem(infix) Then
                If infix(1) = ")" Then ArrayShift infix
            End If
        Else
            ArrayPush postfix, ArrayShift(infix)
        End If
    End If

End Sub

Private Sub Term(ByRef infix, ByRef postfix)

    Call Factor(infix, postfix)
    
    Do While HasItem(infix)
        Dim c: c = infix(1)
        If c = "*" Or c = "/" Then
            ArrayShift infix
            Call Factor(infix, postfix)
            ArrayPush postfix, c
        Else
            Exit Do
        End If
    Loop

End Sub

Private Sub Expression(ByRef infix, ByRef postfix)

    Call Term(infix, postfix)
    
    Do While HasItem(infix)
        Dim c: c = infix(1)
        If c = "+" Or c = "-" Then
            ArrayShift infix
            Call Term(infix, postfix)
            ArrayPush postfix, c
        Else
            Exit Do
        End If
    Loop

End Sub

'# 配列操作用の関数
Private Function ArrayPush(ByRef ArrayItems, ByVal PushedItem)

    ReDim Preserve ArrayItems(UBound(ArrayItems) + 1)
    ArrayItems(UBound(ArrayItems)) = PushedItem

End Function


Private Function ArrayPop(ByRef ArrayItems)

    If HasItem(ArrayItems) Then
        ArrayPop = ArrayItems(UBound(ArrayItems))
        ReDim Preserve ArrayItems(UBound(ArrayItems) - 1)
    End If

End Function

Private Function ArrayShift(ByRef ArrayItems)

    If HasItem(ArrayItems) Then
        ArrayShift = ArrayItems(1)
        Dim i
        For i = 2 To UBound(ArrayItems)
            ArrayItems(i - 1) = ArrayItems(i)
        Next
        ReDim Preserve ArrayItems(UBound(ArrayItems) - 1)
    End If

End Function

Private Function HasItem(ByRef ArrayItems)

    HasItem = Not (UBound(ArrayItems) = 0)

End Function