次元数がわからない配列変数の処理をシンプルにするVBA関数

今回は次元数の分からない配列に対して共通の処理系で全て処理できるようにするVBA関数を作ったので紹介する。

作ったもの
- GetArrプロパティ
- LBT関数、UBT関数
2次元までしか対応していないプログラム
3次元までしか対応していないプログラム
次元数に関係なく動作する関数
活用事例
- n次元配列のテストデータを作成する関数
参考資料
まとめ

作ったもの

図のような次元数が分からない配列変数に対する分岐処理を、一つに圧縮する関数を作成した。

最終的なプログラムは、20200725_配列の次元数に関係なく読み書きする関数で公開している。

GetArrプロパティ

余分な次元のインデックスを無視して配列変数から値を取得するプロパティ（関数みたいなもん）

変数の種類＼利用法	従来	改良版(三次元サポートの場合)	備考
非配列	v0	GetArr(v0, 1, 2, 3)	1, 2, 3は無視される
一次元配列	v1(1)	GetArr(v1, 1, 2, 3)	2, 3は無視される
二次元配列	v2(1, 2)	GetArr(v2, 1, 2, 3)	3は無視される
三次元配列	v3(1, 2, 3)	GetArr(v3, 1, 2, 3)

LBT関数、UBT関数

存在しない次元では1を取得してエラーを起こさないLBound、UBoundのラップ関数

変数の種類＼2次元目の要素番号取得例	従来	←備考	改良版	←備考
非配列	LBound(v0, 2)	※エラー	LBT(v0, 2)	存在しない次元では1を返す
一次元配列	LBound(v1, 2)	※エラー	LBT(v1, 2)	存在しない次元では1を返す
二次元配列	LBound(v2, 2)		LBT(v2, 2)
三次元配列	LBound(v3, 2)		LBT(v3, 2)

2次元までしか対応していないプログラム

まずは、通常のプログラムがどうなっているか説明する。

これは、DebugPrintVar_012 変数名と書くことで、あらゆる変数の内容をイミディエイトに出力するプログラムである。

デバッグを効率的に行うために開発したが、2次元配列までしか対応していない暫定版である。

ソースコード

Rem 非配列、一次元配列、二次元配列の内容を出力するテスト
Sub Test_DebugPrintVar_012()

    Dim v0: v0 = 1
    Dim v1: v1 = VBA.Array(1, 2, 3)
    Dim v2: v2 = [{1,2;3,4;5,6}]
    
    DebugPrintVar_012 v0
    DebugPrintVar_012 v1
    DebugPrintVar_012 v2
    
End Sub

Rem 変数vの内容をイミディエイトに出力するプロシージャ
Sub DebugPrintVar_012(v)
    Dim i As Long, j As Long
    Select Case GetArrayDimension(v)
        Case 0
            Debug.Print "v", v
        Case 1
            For i = LBound(v, 1) To UBound(v, 1)
                Debug.Print "v(" & i & ")", v(i)
            Next
        Case 2
            For i = LBound(v, 1) To UBound(v, 1)
                For j = LBound(v, 2) To UBound(v, 2)
                    Debug.Print "v(" & i & "," & j & ")", v(i, j)
                Next
            Next
    End Select
    Debug.Print
End Sub

Rem 配列の次元数を求める関数
Public Function GetArrayDimension(ByRef arr As Variant) As Long
    On Error GoTo ENDPOINT
    Dim i As Long, tmp As Long
    For i = 1 To 61
        tmp = LBound(arr, i)
    Next
    GetArrayDimension = 0
    Exit Function
    
ENDPOINT:
    GetArrayDimension = i - 1
End Function

出力

Test_DebugPrintVar_012を実行すると次のような結果が得られる

v        1 

v(0)       1 
v(1)       2 
v(2)       3 

v(1,1)      1 
v(1,2)      2 
v(2,1)      3 
v(2,2)      4 
v(3,1)      5 
v(3,2)      6

問題点

注目して欲しいのは、DebugPrintVar_012(v)の内容。

Select Case GetArrayDimension(v) により次元数を算出し、次元数ごとに処理を振り分けている。

察しの良い方は既に問題に気がついているはず。

拡張が大変なのである。

3次元までしか対応していないプログラム

上記プログラムを3次元に対応させてみる。

※3次元配列のテストデータを一発で作成できる記法が無いため、CreateTestData3を追加した。

ソースコード

Sub Test_DebugPrintVar_0123()

    Dim v0: v0 = 1
    Dim v1: v1 = VBA.Array(1, 2, 3)
    Dim v2: v2 = [{1,2;3,4;5,6}]
    Dim v3: v3 = CreateTestData3(1, 2, 3)
    
    DebugPrintVar_0123 v0
    DebugPrintVar_0123 v1
    DebugPrintVar_0123 v2
    DebugPrintVar_0123 v3
    
End Sub

Rem 変数vの内容をイミディエイトに出力するプロシージャ
Sub DebugPrintVar_0123(v)
    Dim i As Long, j As Long, k As Long
    Select Case GetArrayDimension(v)
        Case 0
            Debug.Print "v", v
        Case 1
            For i = LBound(v, 1) To UBound(v, 1)
                Debug.Print "v(" & i & ")", v(i)
            Next
        Case 2
            For i = LBound(v, 1) To UBound(v, 1)
                For j = LBound(v, 2) To UBound(v, 2)
                    Debug.Print "v(" & i & "," & j & ")", v(i, j)
                Next
            Next
        Case 3
            For i = LBound(v, 1) To UBound(v, 1)
                For j = LBound(v, 2) To UBound(v, 2)
                    For k = LBound(v, 3) To UBound(v, 3)
                        Debug.Print "v(" & i & "," & j & "," & k & ")", v(i, j, k)
                    Next
                Next
            Next
    End Select
    Debug.Print
End Sub

Rem 配列の次元数を求める関数
Public Function GetArrayDimension(ByRef arr As Variant) As Long
    On Error GoTo ENDPOINT
    Dim i As Long, tmp As Long
    For i = 1 To 61
        tmp = LBound(arr, i)
    Next
    GetArrayDimension = 0
    Exit Function
    
ENDPOINT:
    GetArrayDimension = i - 1
End Function

Rem 3次元配列のテストデータを作成する
Rem @param      s1,s2,s3 配列の要素数
Rem @return     1-2-3形式の文字列の格納された三次元配列
Function CreateTestData3(s1, s2, s3)
    Dim i As Long, j As Long, k As Long
    Dim v
    ReDim v(1 To s1, 1 To s2, 1 To s3)
    For i = LBound(v, 1) To UBound(v, 1)
        For j = LBound(v, 2) To UBound(v, 2)
            For k = LBound(v, 3) To UBound(v, 3)
                v(i, j, k) = Join(Array(i, j, k), "-")
            Next
        Next
    Next
    CreateTestData3 = v
End Function

出力

v        1 

v(0)       1 
v(1)       2 
v(2)       3 

v(1,1)      1 
v(1,2)      2 
v(2,1)      3 
v(2,2)      4 
v(3,1)      5 
v(3,2)      6 

v(1,1,1)     1-1-1
v(1,1,2)     1-1-2
v(1,1,3)     1-1-3
v(1,2,1)     1-2-1
v(1,2,2)     1-2-2
v(1,2,3)     1-2-3

問題点

増えたのは、Selectの分岐先である。

Case 3
    For i = LBound(v, 1) To UBound(v, 1)
        For j = LBound(v, 2) To UBound(v, 2)
            For k = LBound(v, 3) To UBound(v, 3)
                Debug.Print "v(" & i & "," & j & "," & k & ")", v(i, j, k)
            Next
        Next
    Next

二次元のときと比較して

カウンタ変数kを追加
For～Nextが三重ループに変化
配列変数の指定がv(i, j, k)に変化

という編集が必要となる。

サポートしたい次元数が増えれば増えるほと、拡張が大変なのはおわかりいただけただろうか。

そして、VBAの配列は60次元まである。

全パターンプログラムを書こうとしたら大変なことは言うまでも無いだろう。

（とはいえ、普通は4次元くらいまでしか使われることはないはずだが）

もう一つの問題が、同じ処理を何度も書くことになるという点だ。

今回はDebug.Print "v(" & i & ")", v(i)という単純な処理なので複製しても大したことないが、もうすこし少々込み入った処理がある場合には、あまり複製したくない。

ロジックの変更があった時、全箇所同じように直さなければならず、修正漏れが起こりやすい。

上手く関数化できるに越したことはないが、様々な事情から分割できないことも多々ある。

こんな時に便利なのが、今回作成した関数である。

次元数に関係なく動作する関数

先のプログラムのように、次元数で振り分けが必要となるのには、いくつかの要因がある。

LBound、UBoundで存在しない次元を指定するとエラーになる
配列の存在しない要素を指定するとエラーになる
For～Nextの個数が不定

つまり、これらを解消すればソースコードがシンプルになるはずである。

LBound,UBoundのラップ関数

1.LBound、UBoundで存在しない次元を指定するとエラーになる

このエラーを解決するには、エラーを握り潰すように包み込んだ関数を作れば良い。

※このような関数を巷ではラッピングされた関数として「ラッパー」「ラップ関数」などと呼ぶ。

存在しない次元の要素は1とした。別に0でも2でも良いが、変更するならLBTとUBT両方の値を変更すること。合わせておかないとFor i = LBT(v, 1) To UBT(v, 1)で1周回すことが出来なくなる。

Rem 次元数違反でエラーの起こらないLBound
Rem Lower Bound Through
Public Function LBT(var, dimension As Long)
    LBT = 1
    On Error Resume Next
    LBT = LBound(var, dimension)
End Function

Rem 次元数違反でエラーの起こらないUBound
Rem Upper Bound Through
Public Function UBT(var, dimension As Long)
    UBT = 1
    On Error Resume Next
    UBT = UBound(var, dimension)
End Function

Sub Test_Bound()
    
    Dim v0: v0 = 1
    Dim v1: v1 = [{1,2,3}]
    Dim v2: v2 = [{1,2;3,4;5,6}]
    
    Debug.Print "v0 : " & LBT(v0, 1) & " To " & UBT(v0, 1)
    Debug.Print "v0 : " & LBT(v0, 2) & " To " & UBT(v0, 2)
    Debug.Print "v0 : " & LBT(v0, 3) & " To " & UBT(v0, 3)
    Debug.Print
    Debug.Print "v1 : " & LBT(v1, 1) & " To " & UBT(v1, 1)
    Debug.Print "v1 : " & LBT(v1, 2) & " To " & UBT(v1, 2)
    Debug.Print "v1 : " & LBT(v1, 3) & " To " & UBT(v1, 3)
    Debug.Print
    Debug.Print "v2 : " & LBT(v2, 1) & " To " & UBT(v2, 1)
    Debug.Print "v2 : " & LBT(v2, 2) & " To " & UBT(v2, 2)
    Debug.Print "v2 : " & LBT(v2, 3) & " To " & UBT(v2, 3)
    Debug.Print
    
End Sub

実行結果

v0 : 1 To 1
v0 : 1 To 1
v0 : 1 To 1

v1 : 1 To 3
v1 : 1 To 1
v1 : 1 To 1

v2 : 1 To 3
v2 : 1 To 2
v2 : 1 To 1

このように、どのような変数でもエラーを出さないで要素数を返せるようになった。

これは後々

For i = LBT(v, 1) To UBT(v, 1)

のようにして使う。

配列変数の値を取得するプロパティ

2.配列の存在しない要素を指定するとエラーになる

この問題を解決するには、配列の次元数がいくつだろうと要素を取得できる関数を作れば良い。

次のGetArrは、渡された配列の次元数を元に適切な個数のインデックスを使って値を取り出すプロパティとなっている。

※好みで関数ではなくプロパティとしている。基本的にProperty GetはFunctionと全く同じと考えておけば良い。

Rem 次元数不定の変数の値を取得
Rem
Rem  @param arr             読込元変数
Rem  @param idxs()          読込元インデックス配列
Rem
Rem  @return As Variant     取得データ
Rem
Rem  @example v = GetArr(arr, i, j)
Rem
Rem  @note
Rem    過剰に付与されたインデックスは無視される
Rem
Public Property Get GetArr(arr, ParamArray idxs())
    Select Case GetArrayDimension(arr)
        Case 0: SetVar(GetArr) = arr
        Case 1: SetVar(GetArr) = arr(idxs(0))
        Case 2: SetVar(GetArr) = arr(idxs(0), idxs(1))
        Case 3: SetVar(GetArr) = arr(idxs(0), idxs(1), idxs(2))
        Case 4: SetVar(GetArr) = arr(idxs(0), idxs(1), idxs(2), idxs(3))
        Case 5: SetVar(GetArr) = arr(idxs(0), idxs(1), idxs(2), idxs(3), idxs(4))
    End Select
End Property
    
Sub Test_GetArr()

    Dim v0: v0 = 1
    Dim v1: v1 = [{1,2,3}]
    Dim v2: v2 = [{1,2,3;4,5,6;7,8,9}]
    
    Debug.Print GetArr(v0, 2, 3)
    Debug.Print GetArr(v1, 2, 3)
    Debug.Print GetArr(v2, 2, 3)
    
End Sub

実行結果

 1 
 2 
 6

変数の次元数に合わせて左から必要な個数のインデックスのみが使用されているのが分かるはず。

これで、普通に配列からデータを取り出す時と同じように書くことができるようになった。

変数にLetとSetを自動判別して代入するプロパティ

上記で使用されているSetVarとは、カッコ内の変数に右辺のデータを代入するプロパティである。

VBAではデータの種類によってLetとSetを使い分ける必要があるため、このような汎用的なプログラムを書く際には必ず振り分けなければならない。しかし毎回Ifを書いていたら大変なので、プロシージャで一行で書けるようにしている。

※普通はSubで実装するが、好みでプロパティ（Property Set）としている。

Rem 変数に値を代入
Rem
Rem  @param outVariable     出力先変数
Rem  @param inExpression    書き込み内容
Rem
Rem  @example SetVar(out) = in
Rem
Private Property Let SetVar(outVariable As Variant, inExpression As Variant)
    If VBA.IsObject(inExpression) Then
        Set outVariable = inExpression
    ElseIf VBA.VarType(inExpression) = vbDataObject Then
        Set outVariable = inExpression
    Else
        Let outVariable = inExpression
    End If
End Property
        
Sub Test_SetVar()
    
    Dim lit As Long::: Let lit = 1
    Dim obj As Object: Set obj = New Collection
    
    Dim v
    
    Let v = lit     '正常に動く
'    Set v = lit    'コンパイルエラー
    SetVar(v) = lit '自動でLetされる
    
'    Let v = obj    '実行時エラー
    Set v = obj     '正常に動く
    SetVar(v) = obj '自動でSetされる
    
End Sub

Test_SetVarをF8で実行し、ローカルウィンドウを監視しながらステップしていくと、動きがよく分かると思う。

For～Nextの個数が不定の問題の解消

For～Nextの個数が不定

この問題は、既に提示したプロシージャLBT、UBT、 GetArr、SetVarを使えば解消できる。

まず、

要素があるときは、LBound～UBoundまで巡回される。
要素がないときは、LBT、UBTは必ず1 To 1を返すので、1回だけ処理される。

さらに、

GetArr(v, ・・・）により、存在しない次元数のインデックス（カウンタの値は1固定）は無視した状態で配列の値が読み込まれる。

つまり、Forの個数はサポートしたい次元の最大数の数だけ設置すれば良いことになる。

次のように書けば、配列の次元数がいくつだろうと絶対に動く。

※3次元以下をサポート対象としたコード

Rem 変数の内容を出力するだけのプロシージャ
Sub DebugPrintVar(v)
    Dim d1, d2, d3
    For d1 = LBT(v, 1) To UBT(v, 1)
        For d2 = LBT(v, 2) To UBT(v, 2)
            For d3 = LBT(v, 3) To UBT(v, 3)
                Debug.Print _
                    "v(" & d1 & "," & d2 & "," & d3 & ")", _
                    GetArr(v, d1, d2, d3)
            Next
        Next
    Next
    Debug.Print
End Sub