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にあわせる。
すると、先頭の項目が共通になっていることがわかる。
ではこれを外だししよう。
また、最後の条件も共通である。こちらも外だしする。
新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
あとなんとか纏めたいのは、ここと、
ここのわずかな違い。
関数型言語なら演算子を変数に入れてしまったりできるものがあるが、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
見出しもつけずに書きなぐってしまったけど、以上。
