t-hom’s diary

主にVBAネタを扱っているブログ…とも言えなくなってきたこの頃。

ExcelでネストしたIf関数をVBAでインデントして分析しやすくする

ExcelでIF関数を使うと条件によっていろいろと処理を変えることができる。
複雑な条件はIF関数を組み合わせることで実現できるが、やりすぎるとすごく見づらい。

たとえば、以下のような式を作ってみた。

=IF(条件,IF(条件,IF(条件,TRUE,FALSE),IF(条件,IF(条件,FALSE,TRUE),FALSE)),FALSE)

ネストしすぎて解析が困難になっている。

これを解析用にインデントしてみると、このような構造になっていることがわかる。
f:id:t-hom:20170820115954p:plain

VBAと違ってElse文はないけれど、このようにインデントすれば真と偽の対応がわかりやすい。
【注意】解析用のインデントなので、最終的にはタブと改行を削除して元に戻さないと式として使えない。

今回はこの改行とインデントを自動で行うマクロを作ってみた。
技術的にはコンパイラの字句解析を応用したものだ。
これは説明するとすごく長くなるので割愛し、コードだけ貼り付けておく。
※末尾に参考文献を貼り付けておくので興味がある方はどうぞお買い求めください。

コード

準備するモジュールは4つある。

標準モジュール1つ

  • Module1

クラスモジュール3つ

  • Expression
  • Token
  • Stack

Module1のコード

プログラムのエントリーポイント(開始場所)はMainプロシージャである。

Public Enum TokenType
    Target  'If
    BeginParen  '(
    EndParen    ')
    Comma   ',
    Other
End Enum
Public Enum CharType
    Alphabet
    Number
    BeginParen
    EndParen
    Comma
    DoubleQuote
    Other
End Enum

Function GetCharType(c) As CharType
    Dim ret As CharType
    Select Case Asc(c)
    Case Asc("a") To Asc("z"), Asc("A") To Asc("Z")
        ret = CharType.Alphabet
    Case Asc("0") To Asc("9")
        ret = CharType.Number
    Case Else
        Select Case True
            Case c = "(": ret = CharType.BeginParen
            Case c = ")": ret = CharType.EndParen
            Case c = ",": ret = CharType.Comma
            Case c = """": ret = CharType.DoubleQuote
            Case Else
                ret = CharType.Other
        End Select
    End Select
    GetCharType = ret
End Function
Function IsIn(target_, ParamArray check()) As Boolean
    Dim i As Long, ret As Boolean: ret = False
    For i = LBound(check) To UBound(check)
        ret = ret Or check(i) = target_
    Next
    IsIn = ret
End Function

Sub Main()
    Dim targetExpression As Expression: Set targetExpression = New Expression
    targetExpression.ExpressionString = InputBox("数式を入力してください。")
    
    Dim tokens As Collection
    Set tokens = GetTokens(targetExpression)
    Dim t As Token
    
    Dim st As Stack: Set st = New Stack
    Dim tabCount As Long
    For i = 1 To tokens.Count
        Debug.Print tokens(i).tString;
        Select Case tokens(i).tType
            Case TokenType.BeginParen
                If tokens(i - 1).tType = TokenType.Target Then
                    st.Push True
                    tabCount = tabCount + 1
                Else
                    st.Push False
                End If
            Case TokenType.EndParen
                If st.Pop Then tabCount = tabCount - 1
            Case TokenType.Comma
                If st.Top Then
                    Debug.Print
                    Debug.Print String(tabCount, vbTab);
                End If
            Case Else
        End Select
    Next
End Sub

Function GetTokens(targetExpression As Expression) As Collection
    Dim ret As Collection: Set ret = New Collection
    
    Dim t As Token
    Do While targetExpression.hasNext
        Set t = New Token
        t.tString = targetExpression.getNext
        Select Case GetCharType(t.tString)
            Case CharType.Alphabet
                Do While IsIn(GetCharType(targetExpression.checkNext), CharType.Alphabet, CharType.Number)
                    t.AddChar targetExpression.getNext
                Loop
            Case CharType.Number
                Do While GetCharType(targetExpression.checkNext) = CharType.Number
                    t.AddChar targetExpression.getNext
                Loop
            Case CharType.DoubleQuote
                Do While GetCharType(targetExpression.checkNext) <> CharType.DoubleQuote
                    t.AddChar targetExpression.getNext
                Loop
                t.AddChar targetExpression.getNext
            Case CharType.BeginParen
            Case CharType.EndParen
            Case CharType.Comma
            Case CharType.Other
        End Select
        ret.Add t
    Loop
    Set GetTokens = ret
End Function

Expressionクラスのコード

Public ExpressionString
Private cursor
Private Sub Class_Initialize()
    cursor = 1
End Sub

Function hasNext() As Boolean
    hasNext = Len(ExpressionString) > cursor - 1
End Function

Function getNext() As String
    getNext = Mid(ExpressionString, cursor, 1)
    cursor = cursor + 1
End Function

Function checkNext() As String
    If hasNext Then
        checkNext = Mid(ExpressionString, cursor, 1)
    Else
        MsgBox "error"
    End If
End Function

Sub Reset()
    cursor = 1
End Sub

Tokenクラスのコード

Public tString
Sub AddChar(c)
    tString = tString & c
End Sub

Property Get tType() As TokenType
    Dim ret As TokenType
    Select Case UCase(tString)
        Case "IF": ret = TokenType.Target
        Case "(": ret = TokenType.BeginParen
        Case ")": ret = TokenType.EndParen
        Case ",": ret = TokenType.Comma
        Case Else: ret = TokenType.Other
    End Select
    tType = ret
End Property

Stackクラスのコード

Private Items() As Variant

Property Get Count() As Integer
    Count = UBound(Items)
End Property

Property Get Top() As Variant
    Top = Items(UBound(Items))
End Property

Public Function Pop() As Variant
    If UBound(Items) > 0 Then
        Pop = Items(UBound(Items))
        ReDim Preserve Items(UBound(Items) - 1)
    Else
        Pop = Empty
    End If
End Function

Public Sub Push(ByRef x As Variant)
    ReDim Preserve Items(UBound(Items) + 1)
    Items(UBound(Items)) = x
End Sub

Private Sub Class_Initialize()
    ReDim Items(0)
End Sub

実行してみる。

Module1のMainプロシージャを実行すると、インプットボックスが表示されるので適当なネストしたIF関数を入れる。
f:id:t-hom:20170820121126p:plain

OKをクリックすると、イミディエイトウインドウ内にインデントされた式が出てくる。
f:id:t-hom:20170820121303p:plain

ネストしたIFを考えるのが面倒なので、以下のサイトからサンプルをいくつかいただいてきた。
Excel(エクセル)関数の技:IF関数のネスト(入れ子)の方法

例1)

=IF(C3="","",IF(C3>60,"○",IF(C3>30,"△","×"))

=IF(C3="",
    "",
    IF(C3>60,
        "○",
        IF(C3>30,
            "△",
            "×"))

例2)

=IF(AND(C3>30,C3<=60),"△",IF(AND(C3>=0,C3<=30),"×",IF(AND(C3>60,C3<=100),"○","")))

=IF(AND(C3>30,C3<=60),
    "△",
    IF(AND(C3>=0,C3<=30),
        "×",
        IF(AND(C3>60,C3<=100),
            "○",
            "")))

例3)
日本語まじりの抽象式でもこのとおり。

=IF(論理式1, [真の場合1], IF(論理式2, [真の場合2], IF(論理式3, [真の場合3], [偽の場合3])))

=IF(論理式1,
     [真の場合1],
     IF(論理式2,
         [真の場合2],
         IF(論理式3,
             [真の場合3],
             [偽の場合3])))

参考文献

初版48ページ 字句解析プログラム

【注意】VBAの書籍ではありません。C言語で書かれてます。

2017/08/26 修正

GetCharType関数でNumberの判定が1~9になってたのを0~9に修正しました。
※今回のIFの判定に影響はありません。

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