Excelで関数型プログラミングに目覚めたかもしれない。（基礎編）

最初に

　Excelで業務用のVBAを書いているのですが、ボタンを押してマクロを起動させるやり方に違和感を感じていました。そこで全てVBAの関数でアプリを構築出来ないかと思ったわけです。
今流行りの関数型プログラミングというものをやってみたかったので、最初に定義した関数は、

Function IFC(C, V, Optional S = "")      ' IF C THEN V ELSE S
    If C Then IFC = V Else IFC = S
End Function

これで、IF文を書かないで関数IFCで済ませられます。

テーブルと構造的参照

Excelでアプリを構築した場合に、名前の管理が煩わしく思いました。アプリを構築した最初は、テーブルの存在を知らなかったので、Rangeを表す名前が増殖して大変でした。テーブルを使うと、Rangeの範囲を自動的にやってくれるので大変便利です。
マウスでセルの範囲を指定して、テーブルを挿入、その際、先頭行をテーブルの見出しとして使用するにチャックを入れるだけです。
見にくくなるので、最初はフィルターを外し、罫線は入れます。

テーブル名は、AA_ といったように英字の後にアンダーバーを付けます。構造的参照を使うとき、見出しが　A だと、列は、AA_[A]　となり、見やすくなるからです。列が連続している場合は、AA_[[A]:[C]]の様に、複数列を参照できるので便利です。
テーブル名や、構造的参照の部分列は、上手いことに Rangeとして関数の引数に渡せます。

テーブル用の関数

アプリとして動作させる為に、テーブル内のセルに関数を埋め込むのですが、そのための専用の関数を定義します。

Function MM(R)                          ' TABLE ROW
    MM = Application.ThisCell.Row - R.Row + 1
End Function

Function NN(R)                          ' TABLE COLUMN
    NN = Application.ThisCell.Column - R.Column + 1
End Function

これらは、呼ばれた関数がテーブル内のどの位置に居るかを教えてくれます。この情報を使うことによりプログラミングを簡単にすることが出来ます。

MATCH,INDEXの再定義

WorksheetFunctionのMATCH,INDEXを組み合わせた検索は、高速なのは知られているのですが、VBA内で使用する為に再定義します。
いちいち、WorksheetFunctionなんて書いていられませんから。
On Error Resume Nextを入れることにより、エラーが出たら長さ０の文字列を返す仕様にしています。エラートラップが面倒ですから。

Function MI(R, Optional V = 0, Optional S = "") 
   On Error Resume Next
   S = WorksheetFunction.Match(V, R, 0)
   MI = S
End Function

Function DI(R, I, Optional J = 1, Optional S = "")     
    On Error Resume Next
    If I > 0 Then S = WorksheetFunction.Index(R, I, J)
    DI = S
End Function

関数MI の一般化

MATCHは高速で便利なのですが、複雑な検索に向きません。検索の範囲を自由に変更することや、複数キーにの対応したいものです。
検索範囲の変更は、VBAの OFFSET,RESIZE を使います。
関数IFZSは、関数IFCを使って定義してますので、すっきりしています。

Function RR(R, Optional M = 1, Optional N = 1, Optional H = 0, Optional W = 1, Optional S = "")  ' RANGE RESIZE
    On Error Resume Next
    H = IFZS(H, 2 - M + R.Rows.Count)
    W = IFZS(W, 1 - N + R.Columns.Count)
    S = R.Offset(M - 1, N - 1).Resize(H, W)
    RR = S
End Function

Function IFZS(V, Optional S = "")        ' IF ZERO THEN S
    IFZS = IFC(V = 0, S, V)
End Function

複数キー対応、検索範囲変更の拡張を行った関数 MPを定義します。
R1は、検索先のRange,R2は検索元のRange,Lはキーの個数、PはMIで検索するキーの位置、
M1,M2は、R1,R2のポインターです。

Function MP(R1, R2, Optional L = 2, Optional P = 1, Optional M1 = 0, Optional M2 = 0, Optional S = "")  ' MATCH PAIR
    On Error Resume Next

    Dim V: V = MV(R2, M2, L, P):
    S = MLOOP(R1, R2, M1, M2, L, P, V) 
    MP = S
End Function

Function MV(R, M, L, P, Optional S = "")               ' MATCH VALUE
    M = IFZS(M, MM(R))
    L = IFZS(L, R.Columns.Count)
    S = DI(R, M, P)
    MV = S
End Function

Function MLOOP(R1, R2, M1, M2, L, P, V, Optional S = "")
    If V <> "" Then
        Dim I: For I = 1 To R1.Rows.Count
            M1 = MN(R1, M1, P, V)
            If M1 = "" Then Exit For
            If MEQ(R1, R2, M1, M2, L) Then
                S = M1
                Exit For
            End If
        Next I
    End If
    MLOOP = S
End Function

Function MN(R, M, N, V, Optional S = "")               ' MATCH NEXT
    On Error Resume Next
    S = IFNSA(MI(RR(R, M + 1, N), V), M)
    MN = S
End Function

Function IFNSA(V, Optional S = 0)        ' IF NOT V = "" THEN ADD S
    On Error Resume Next
    S = IFC(V = "", V, V + S)
    IFNSA = S
End Function

Function MEQ(R1, R2, M1, M2, L, Optional S = True)     ' MATCH EQUAL
    Dim J: For J = 1 To L
        If DI(R1, M1, J) <> DI(R2, M2, J) Then
            S = False
            Exit For
        End If
    Next J
    MEQ = S
End Function

最後に

これで、基本的な関数は出揃いました。
長くなったので、ここで区切ります。
応用編はまた今度。

ではでは。