VBA 任意個の引数が全て同じ値かどうかを判定する関数を作る

プログラムを書いていて、Aが1で、かつBも1ならば処理を実行するというようなケースが時折発生する。

これを素直に書くとこういうコードになる。

If A = 1 And B = 1 Then
    MsgBox "処理"
End If

しかし、さらにCやDも増えたらだんだん冗長なコードになってくる。

If A = 1 And B = 1 And C = 1 And D = 1 Then
    MsgBox "処理"
End If

また、現実のコードは大抵、ABCなんていうシンプルなものではない。

If Range("A1").Value = Arr(10) And Range("A1").Value = ナントカコレクション.Item(x) Then
    MsgBox "処理"
End If

そこで、画期的というわけではないが、あると地味に便利な等価比較関数を作ってみた。

Function Equal(ParamArray Arr() As Variant) As Boolean
    For Each x In Arr
        If x <> Arr(0) Then
            Exit Function
        End If
    Next
    Equal = True
End Function

この関数はParamArrayで受け取った配列をFor Eachでまわし、最初の値Arr(0)と不一致があった時点でExitする。
Boolean型の初期値はFalseなので、ループの途中でExitしたらそのままFalseが返る。
最後までExitしなければ、Trueを返すという仕組みである。

使い方は簡単で、最初のプログラムをこの関数に置き換えるとこうなる。

If Equal(A, B, 1) Then
    MsgBox "処理"
End If

等価比較なので引数の順は1,A,Bでも、B,1,Aでもなんでも良い。

ただし、この関数はオブジェクト型の比較には使えない。

若干複雑になるが、オブジェクトの比較にも対応させたのがこちら。

Function Equal(ParamArray Arr() As Variant) As Boolean
    Const IndexError = 9
    On Error GoTo ERR
    If IsObject(Arr(0)) Then
        For Each x In Arr
            If Not x Is Arr(0) Then Exit Function
        Next
    Else
        For Each x In Arr
            If x <> Arr(0) Then Exit Function
        Next
    End If
Fin:
    Equal = True
    On Error GoTo 0
    Exit Function
ERR:
    If ERR.Number = IndexError Then GoTo Fin
    Equal = False
End Function

オブジェクトを渡すと、Isで同一かどうかチェックする。

Sub test()
    Set a = New Collection
    Set b = a
    Set c = a
    Debug.Print Equal(a, b, c)
End Sub

これまでどおり組み込み型でももちろん動作する。

On Errorステートメントでエラーをトラップするようになっている。
発生する可能性のあるエラーは以下の3種類。

引数無しで呼び出した場合：
　ErrNo.9 インデックスが有効範囲にありません。

オブジェクトをと組み込み型の値を=で比較した場合：
　ErrNo.450 引数の数が一致していません。または不正なプロパティを指定しています。

オブジェクトと組み込み型の値をIsで比較した場合：
　ErrNo.424 オブジェクトが必要です。

このうち引数無しのErrNo.9は、Finに飛ばしてTrueを返すようにした。
If 無=無でTrueという理屈。

こういう地味に便利な関数をたくさん集めると、関数ライブラリと呼べるものになる。
まだまだネタが足りないけれど、いつか自分のライブラリを公開できたら良いなと思う。