読者です 読者をやめる 読者になる 読者になる

t-hom’s diary

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

VBA If文の多重ネストを回避するチュートリアル

VBA

Chemiphysさんのブログで

If文のお化け

フィールド数が多いデータに取り組む④ - chemiphys’s blog

という名言を発見。

どうやら条件が増えすぎてIf文が多重ネストになってしまうということらしい。
ちょっと修正してみたので記事にして良いですかと確認を取ったところ快くOKしてくれたので紹介。

以下、オリジナルのマクロから該当のプロシージャだけ抜粋したもの。

Sub CSort(Col As Collection, Key1 As String, Key1昇順 As Boolean, Optional Key2 As String, Optional Key2昇順 As Boolean)
    Dim p1 As person, p2 As person
    Dim p1k1 As Variant, p2k1 As Variant, p1k2 As Variant, p2k2 As Variant
    'バブルソート
    Dim i As Long, j As Long
    For i = 1 To Col.Count
        For j = Col.Count To i Step -1
            Set p1 = Col(i)
            Set p2 = Col(j)
            
            If IsNumeric(Key1) Then
                p1k1 = CallByName(p1, "GetParameter", VbMethod, Key1)
                p2k1 = CallByName(p2, "GetParameter", VbMethod, Key1)
            Else
                p1k1 = CallByName(p1, Key1, VbGet)
                p2k1 = CallByName(p2, Key1, VbGet)
            End If
            
            If Key2 <> "" Then
                If IsNumeric(Key2) Then
                    p1k2 = CallByName(p1, "GetParameter", VbMethod, Key2)
                    p2k2 = CallByName(p2, "GetParameter", VbMethod, Key2)
                Else
                    p1k2 = CallByName(p1, Key2, VbGet)
                    p2k2 = CallByName(p2, Key2, VbGet)
                End If
            End If
            
            If Key1昇順 = True Then
                If Key2 <> "" Then
                    If p1k1 > p2k1 Then
                        CollectionSwap Col, i, j
                    ElseIf p1k1 = p2k1 Then
                        If Key2昇順 = True Then
                            If p1k2 > p2k2 Then CollectionSwap Col, i, j
                        Else
                            If p1k2 < p2k2 Then CollectionSwap Col, i, j
                        End If
                    End If
                Else
                    If p1k1 > p2k1 Then CollectionSwap Col, i, j
                End If
            Else
                If Key2 <> "" Then
                    If p1k1 < p2k1 Then
                        CollectionSwap Col, i, j
                    ElseIf p1k1 = p2k1 Then
                        If Key2昇順 = True Then
                            If p1k2 > p2k2 Then CollectionSwap Col, i, j
                        Else
                            If p1k2 < p2k2 Then CollectionSwap Col, i, j
                        End If
                    End If
                Else
                    If p1k1 > p2k1 Then CollectionSwap Col, i, j
                End If
            End If
        Next j
    Next i
End Sub

確かにIfのネストが深い。
特に「If Key1昇順 = True Then」以降が長いので、今回はここを修正していく方法をチュートリアル形式で解説しようと思う。

まずこの一番深いネストのIf文を、外部プロシージャに切り出してしまおう。
このように分割しても、必要な変数を全部引数で持ってこれば正常に動作する。

Sub 外部プロシージャ化(Key1昇順,Key2昇順, key2, p1k1, p2k1, p1k2, p2k2, Col, i, j)
    If Key1昇順 = True Then
        If key2 <> "" Then
            If p1k1 > p2k1 Then
                CollectionSwap Col, i, j
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then CollectionSwap Col, i, j
                Else
                    If p1k2 < p2k2 Then CollectionSwap Col, i, j
                End If
            End If
        Else
            If p1k1 > p2k1 Then CollectionSwap Col, i, j
        End If
    Else
        If key2 <> "" Then
            If p1k1 < p2k1 Then
                CollectionSwap Col, i, j
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then CollectionSwap Col, i, j
                Else
                    If p1k2 < p2k2 Then CollectionSwap Col, i, j
                End If
            End If
        Else
            If p1k1 > p2k1 Then CollectionSwap Col, i, j
        End If
    End If
End Sub

さて、次にこのプロシージャの役割は何だろうと考える。
このプロシージャのIf文はすべて、CollectionSwapを呼ぶか呼ばないかを決めるものである。
呼び出す際の引数もCol, i, jで固定。ということは最終的には呼ぶ・呼ばないの二択で良いのだ。
ということで、判定をフラグ化して呼び出し自体は最後にまとめてしまおう。

Sub 外部プロシージャ化(Key1昇順,Key2昇順, key2, p1k1, p2k1, p1k2, p2k2, Col, i, j)
    Dim flag As Boolean: flag = False
    If Key1昇順 = True Then
        If Key2 <> "" Then
            If p1k1 > p2k1 Then
                flag = True
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = True
                Else
                    If p1k2 < p2k2 Then flag = True
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = True
        End If
    Else
        If Key2 <> "" Then
            If p1k1 < p2k1 Then
                flag = True
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = True
                Else
                    If p1k2 < p2k2 Then flag = True
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = True
        End If
    End If
    If flag Then CollectionSwap Col, i, j
End Sub

いやまてよ。。ここでもし2回CollectionSwapが呼ばれるようなケースが存在する場合、これではまずい。
CollectionSwapは2回呼び出すと元通りになってしまうが、flag = Trueは何回呼んでもTrueである。つまり厳密に状態を再現できていない。

ということで、2回呼び出すと元に戻るように変更する。
flag = Not flagとしておけば、呼び出すたびに反転する。

Sub 外部プロシージャ化(Key1昇順,Key2昇順, key2, p1k1, p2k1, p1k2, p2k2, Col, i, j)
    Dim flag As Boolean: flag = False
    If Key1昇順 = True Then
        If Key2 <> "" Then
            If p1k1 > p2k1 Then
                flag = Not flag
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = Not flag
                Else
                    If p1k2 < p2k2 Then flag = Not flag
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = Not flag
        End If
    Else
        If Key2 <> "" Then
            If p1k1 < p2k1 Then
                flag = Not flag
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = Not flag
                Else
                    If p1k2 < p2k2 Then flag = Not flag
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = Not flag
        End If
    End If
    If flag Then CollectionSwap Col, i, j
End Sub

次に、外部プロシージャ化したものを今度は関数化する。
Swap判定というマクロ名に変更し、SubからFunctionに変更する。
CollectionSwapの呼び出しは本体のコードに戻すので、引数のCol, i jは不要になる。

Function Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If Key1昇順 = True Then
        If key2 <> "" Then
            If p1k1 > p2k1 Then
                flag = Not flag
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = Not flag
                Else
                    If p1k2 < p2k2 Then flag = Not flag
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = Not flag
        End If
    Else
        If key2 <> "" Then
            If p1k1 < p2k1 Then
                flag = Not flag
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = Not flag
                Else
                    If p1k2 < p2k2 Then flag = Not flag
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = Not flag
        End If
    End If
    Swap判定 = flag
End Function

さて、いよいよIfのネストを解消していきたいが、その前にまだ準備がある。
Swap判定関数を丸ごとコピーし、オリジナルの方を「旧Swap判定」、新しい方を「新Swap判定」に変更する。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    '省略
    新Swap判定 = flag
End Function

Function 旧Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    '省略
    旧Swap判定 = flag
End Function

現時点で新と旧の中身は全く同じ。唯一マクロ名と戻り値の代入部分だけが異なる2つの関数ができた。

そして次にテストコードを書く。

Sub 新Swap判定と旧Swap判定が等価であることのテスト()
    Dim Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2
    For Each Key1昇順 In Array(True, False)
    For Each Key2昇順 In Array(True, False)
    For Each key2 In Array("aaa", "")
    For Each p1k1 In Array(1, 3, 5)
    For Each p2k1 In Array(1, 3, 5)
    For Each p1k2 In Array(1, 3, 5)
    For Each p2k2 In Array(1, 3, 5)
        '↓とまったらアウト
        Debug.Assert _
        新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) = _
        旧Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2)
    Next: Next: Next: Next: Next: Next: Next
    MsgBox "正常に終了"
End Sub

これは、どのような引数を与えても2つの関数が返す値が同じになることを検証するものである。
現時点では2つの関数は中身が同じだから、当然正常に終了する。

これから新Swap判定をいじっていくが、中身をどれだけ変更しても、このテストさえパスすれば、新Swap判定は旧Swap判定と等価であるといえる。

つまりロジックを壊さずに安全にコードをいじる方法として、テストコードを用意しておくのだ。
そのためにわざわざ外部関数化した。コードをできる限りテスト可能にしておく、つまり関数化しておくことが安全にメンテナンスを行うコツである。

テストに関しては以下の記事でも書いた。
thom.hateblo.jp

ではいよいよ改造をはじめる。
まずは早期リターンを実現するため、新Swap判定関数の終わり付近に仮でQuitというフラグを追加する。

    End If
Quit:
    新Swap判定 = flag
End Function

早期リターンについては以下記事参照。
thom.hateblo.jp

次に「If Key1昇順 = True Then」の内部を早期リターンに書き換える。
■Before

        If key2 <> "" Then
            If p1k1 > p2k1 Then
                flag = Not flag
            ElseIf p1k1 = p2k1 Then
                If Key2昇順 = True Then
                    If p1k2 > p2k2 Then flag = Not flag
                Else
                    If p1k2 < p2k2 Then flag = Not flag
                End If
            End If
        Else
            If p1k1 > p2k1 Then flag = Not flag
        End If

■After

        If key2 = "" Then
            If p1k1 > p2k1 Then flag = Not flag
            GoTo Quit
        End If
        If p1k1 > p2k1 Then
            flag = Not flag
        ElseIf p1k1 = p2k1 Then
            If Key2昇順 = True Then
                If p1k2 > p2k2 Then flag = Not flag
            Else
                If p1k2 < p2k2 Then flag = Not flag
            End If
        End If

これでネストが1つ減った。ここでテストコードを実行し、正常終了するのを確認する。
「If Key1昇順 = True Then」に対応するElseの内部も、同様の変更を行う。

中央付近「ElseIf p1k1 = p2k1 Then」の部分も、分離して単純なIf文に変更する。

新Swap判定は以下のようになった。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If Key1昇順 = True Then
        If key2 = "" Then
            If p1k1 > p2k1 Then flag = Not flag
            GoTo Quit
        End If
        If p1k1 > p2k1 Then
            flag = Not flag
            GoTo Quit
        End If
        If p1k1 = p2k1 Then
            If Key2昇順 = True Then
                If p1k2 > p2k2 Then flag = Not flag
            Else
                If p1k2 < p2k2 Then flag = Not flag
            End If
        End If
    Else
        If key2 = "" Then
            If p1k1 > p2k1 Then flag = Not flag
            GoTo Quit
        End If
        If p1k1 < p2k1 Then
            flag = Not flag
            GoTo Quit
        End If
        If p1k1 = p2k1 Then
            If Key2昇順 = True Then
                If p1k2 > p2k2 Then flag = Not flag
            Else
                If p1k2 < p2k2 Then flag = Not flag
            End If
        End If
    End If
Quit:
    新Swap判定 = flag
End Function

ここでVBEのウインドウメニューから分割にチェックを入れ、片方のウインドウを「 If Key1昇順 = True Then」に、もう片方をそれに対応するElseにあわせる。

すると、先頭の項目が共通になっていることがわかる。
f:id:t-hom:20170110234046p:plain

ではこれを外だししよう。
また、最後の条件も共通である。こちらも外だしする。
f:id:t-hom:20170110234200p:plain

新Swap判定関数はこのようになった。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If key2 = "" Then
        If p1k1 > p2k1 Then flag = Not flag
        GoTo Quit
    End If
    If Key1昇順 = True Then
        If p1k1 > p2k1 Then
            flag = Not flag
            GoTo Quit
        End If
    Else
        If p1k1 < p2k1 Then
            flag = Not flag
            GoTo Quit
        End If
    End If
    If p1k1 = p2k1 Then
        If Key2昇順 = True Then
            If p1k2 > p2k2 Then flag = Not flag
        Else
            If p1k2 < p2k2 Then flag = Not flag
        End If
    End If
Quit:
    新Swap判定 = flag
End Function

あとなんとか纏めたいのは、ここと、
f:id:t-hom:20170110234526p:plain

ここのわずかな違い。
f:id:t-hom:20170110234635p:plain

関数型言語なら演算子を変数に入れてしまったりできるものがあるが、VBAではできないので、比較演算を外部関数化してしまおう。

Function IsGreater(which, A, B) As Boolean
    Select Case which
    Case 1: IsGreater = A > B
    Case 2: IsGreater = A < B
    End Select
End Function

これは、IsGreater(1, A, B)とすると、Aが大きい場合にTrue、IsGreater(2, A, B)とすると、Bが大きい場合にTrueを返す関数だ。

まずはこれを使って単に比較演算を置き換えてみる。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If key2 = "" Then
        If p1k1 > p2k1 Then flag = Not flag
        GoTo Quit
    End If
    If Key1昇順 = True Then
        If IsGreater(1, p1k1, p2k1) Then
            flag = Not flag
            GoTo Quit
        End If
    Else
        If IsGreater(2, p1k1, p2k1) Then
            flag = Not flag
            GoTo Quit
        End If
    End If
    If p1k1 = p2k1 Then
        If Key2昇順 = True Then
            If IsGreater(1, p1k2, p2k2) Then flag = Not flag
        Else
            If IsGreater(2, p1k2, p2k2) Then flag = Not flag
        End If
    End If
Quit:
    新Swap判定 = flag
End Function

すると、「大なり・小なり」の演算子の違いが、数字の1と2の違いに置き換わった。
ということは、Key1昇順、Key2昇順のフラグをIIf関数で数字の1と2に置き換えてしまえば。。

こうなる。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If key2 = "" Then
        If p1k1 > p2k1 Then flag = Not flag
        GoTo Quit
    End If
    Dim gtKey1: gtKey1 = IIf(Key1昇順, 1, 2)
    If Key1昇順 = True Then
        If IsGreater(gtKey1, p1k1, p2k1) Then
            flag = Not flag
            GoTo Quit
        End If
    Else
        If IsGreater(gtKey1, p1k1, p2k1) Then
            flag = Not flag
            GoTo Quit
        End If
    End If
    If p1k1 = p2k1 Then
        Dim gtKey2: gtKey2 = IIf(Key2昇順, 1, 2)
        If Key2昇順 = True Then
            If IsGreater(gtKey2, p1k2, p2k2) Then flag = Not flag
        Else
            If IsGreater(gtKey2, p1k2, p2k2) Then flag = Not flag
        End If
    End If
Quit:
    新Swap判定 = flag
End Function

そうすると先ほどなんとかしたいと言っていた部分が共通化されるので、まとめてしまえる。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If key2 = "" Then
        If p1k1 > p2k1 Then flag = Not flag
        GoTo Quit
    End If
    Dim gtKey1: gtKey1 = IIf(Key1昇順, 1, 2)
    If IsGreater(gtKey1, p1k1, p2k1) Then
        flag = Not flag
        GoTo Quit
    End If
    If p1k1 = p2k1 Then
        Dim gtKey2: gtKey2 = IIf(Key2昇順, 1, 2)
        If IsGreater(gtKey2, p1k2, p2k2) Then flag = Not flag
    End If
Quit:
    新Swap判定 = flag
End Function

十分短くなったのでGoto文を一つ消してElseに置き換え、

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If key2 = "" Then
        If p1k1 > p2k1 Then flag = Not flag
    Else
        Dim gtKey1: gtKey1 = IIf(Key1昇順, 1, 2)
        If IsGreater(gtKey1, p1k1, p2k1) Then
            flag = Not flag
            GoTo Quit
        End If
        If p1k1 = p2k1 Then
            Dim gtKey2: gtKey2 = IIf(Key2昇順, 1, 2)
            If IsGreater(gtKey2, p1k2, p2k2) Then flag = Not flag
        End If
    End If
Quit:
    新Swap判定 = flag
End Function

もう一つもElseIfに置き換えてしまえば、Quitフラグも不要になり、こうなる。

Function 新Swap判定(Key1昇順, Key2昇順, key2, p1k1, p2k1, p1k2, p2k2) As Boolean
    Dim flag As Boolean: flag = False
    If key2 = "" Then
        If p1k1 > p2k1 Then flag = Not flag
    Else
        Dim gtKey1: gtKey1 = IIf(Key1昇順, 1, 2)
        If IsGreater(gtKey1, p1k1, p2k1) Then
            flag = Not flag
        ElseIf p1k1 = p2k1 Then
            Dim gtKey2: gtKey2 = IIf(Key2昇順, 1, 2)
            If IsGreater(gtKey2, p1k2, p2k2) Then flag = Not flag
        End If
    End If
    新Swap判定 = flag
End Function

最後にテストコードを実行し、元のコードと等価であることを確認する。

そのまま関数としてメインコードから呼ぶ形でもよいし、メインのコードに書き戻すと、こうなる。

Sub CSort(Col As Collection, Key1 As String, Key1昇順 As Boolean, Optional key2 As String, Optional Key2昇順 As Boolean)
    Dim p1 As Person, p2 As Person
    Dim p1k1 As Variant, p2k1 As Variant, p1k2 As Variant, p2k2 As Variant
    'バブルソート
    Dim i As Long, j As Long
    For i = 1 To Col.Count
        For j = Col.Count To i Step -1
            Set p1 = Col(i)
            Set p2 = Col(j)
            
            If IsNumeric(Key1) Then
                p1k1 = CallByName(p1, "GetParameter", VbMethod, Key1)
                p2k1 = CallByName(p2, "GetParameter", VbMethod, Key1)
            Else
                p1k1 = CallByName(p1, Key1, VbGet)
                p2k1 = CallByName(p2, Key1, VbGet)
            End If
            
            If key2 <> "" Then
                If IsNumeric(key2) Then
                    p1k2 = CallByName(p1, "GetParameter", VbMethod, key2)
                    p2k2 = CallByName(p2, "GetParameter", VbMethod, key2)
                Else
                    p1k2 = CallByName(p1, key2, VbGet)
                    p2k2 = CallByName(p2, key2, VbGet)
                End If
            End If
            
            '↓新Swap判定のコードを書き戻した。
            Dim flag As Boolean: flag = False
            If key2 = "" Then
                If p1k1 > p2k1 Then flag = Not flag
            Else
                Dim gtKey1: gtKey1 = IIf(Key1昇順, 1, 2)
                If IsGreater(gtKey1, p1k1, p2k1) Then
                    flag = Not flag
                ElseIf p1k1 = p2k1 Then
                    Dim gtKey2: gtKey2 = IIf(Key2昇順, 1, 2)
                    If IsGreater(gtKey2, p1k2, p2k2) Then flag = Not flag
                End If
            End If
            If flag Then CollectionSwap Col, i, j
        Next j
    Next i
End Sub

Function IsGreater(which, A, B) As Boolean
    Select Case which
    Case 1: IsGreater = A > B
    Case 2: IsGreater = A < B
    End Select
End Function

見出しもつけずに書きなぐってしまったけど、以上。

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