Excel VBAで二次元配列の一次元目を拡張する

目次

Excel VBAで一次元配列の要素数を変更する場合、ReDimを使って次のように書く。

Sub sample1()
    Dim myArray()
    ReDim myArray(0): myArray(0) = "7月3日"
    ReDim Preserve myArray(1): myArray(1) = "7月4日"
End Sub

二次元配列の場合は、二次元目の要素数の変更は簡単だが、一次元目の要素数の変更は少し面倒だ。 なぜなら、ReDim Preserveで要素数を変更できるのは、最後の要素に限られるからだ。 例えば、以下のsample2のように行列の「列」の拡張は問題ないが、sample3のような「行」の拡張はエラーとなる。

Sub sample2()
    Dim myArray()
    ReDim myArray(0, 1)
    myArray(0, 0) = "7月3日"
    myArray(0, 1) = "A社訪問"
    ReDim Preserve myArray(0, 2)
    myArray(0, 2) = "セミナー参加"
End Sub

Sub sample3()
    Dim myArray() As String
    ReDim myArray(0,1)
    myArray(0,0) = "7月3日"
    myArray(0,1) = "平日"
    ReDim Preserve myArray(1,1) 'ここでエラーになる
    myArray(1,0) = "7月4日"
    myArray(1,1) = "休日"
End Sub

泥臭いやり方だが、別途配列を用意して拡張後の要素数で再定義し、拡張元配列の値をセットしてやればよい。コードにすればこんな感じ。

'//////////////////////////////////
' 二次元配列の一次元目の拡張
'  入力引数1(orgArray) : 拡張元の配列
'  入力引数2(lengthTo) : 拡張後の要素数
'  戻り値 : 拡張後の配列
'//////////////////////////////////
Function RedimPreserve2D(ByVal orgArray, ByVal lengthTo)
    Dim retArray()
    Dim firstMaxIdx, secondMaxIdx
    Dim i, j

    ' 要素数の取得
    firstMaxIdx = UBound(orgArray, 1)
    secondMaxIdx = UBound(orgArray, 2)

    ' 拡張後配列の定義。拡張元配列の一次元目要素数に入力引数2を指定。
    ReDim retArray(lengthTo, secondMaxIdx)

    ' 拡張後配列に拡張元配列の値をセット
    For i = 0 To firstMaxIdx
        For j = 0 To secondMaxIdx
            retArray(i, j) = orgArray(i, j)
        Next
    Next

    RedimPreserve2D = retArray
End Function

sample3を書き直せば、以下のようになる。

Sub sample3_modify()
    Dim myArray()
    ReDim myArray(0, 1)
    myArray(0, 0) = "7月3日"
    myArray(0, 1) = "平日"
    myArray = RedimPreserve2D(myArray, 1)
    myArray(1, 0) = "7月4日"
    myArray(1, 1) = "休日"
End Sub

関連ページ