最初に
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を入れることにより、エラーが出たら長さ0の文字列を返す仕様にしています。エラートラップが面倒ですから。
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
最後に
これで、基本的な関数は出揃いました。
長くなったので、ここで区切ります。
応用編はまた今度。
ではでは。