【VBA】使い回せる配列操作用プロシージャ

VBAの配列操作アレコレ

定期的にVBAでツールの作成依頼が来るのですが、大体は外部ファイルを読み込んで処理してExcelワークシートなりCSVに出力するような機能のものが多いです。
そこで頻出するのが配列に関する処理。
配列を使用すると、しない場合に比べて「応答なし」になる確率が下がり、処理時間も短くなることが多いです。
だけどVBAの配列は、本職Java屋の私にはちょっと癖がある！ので、汎用的なプロシージャを作ってはため込んで再利用しています。
この記事では、よく使う配列操作用の自作プロシージャをまとめました。
更新や追加等メンテは、随時行っていく予定です。

1. 配列の要素数を取得

VBAには、配列の要素数を取得する関数が存在しません。
UBound(配列)関数は、配列の末尾の添え字(インデックス)を取得する関数であり、要素数の取得ではありません。
例えば、arr(0 to 3)の配列に対してUBound(arr)の結果は「3」です。
ですが、添え字は「0、1、2、3」で、要素数は「4」になります。
arr(1 to 3)であればUBound(arr)の結果は「3」で要素数と一致しますが、先端の添え字をLBound(arr)で取得して確認する必要があります。
また、LBound(arr)、UBound(arr)は、宣言したての動的配列(Dim arr())に対しては、実行時エラー「9」が発生します。
上記仕様により配列の要素数の取得には色々考慮が必要となるので、このようなプロシージャを作成しています。

' 配列の要素数を取得(要素数0対応)
' arr：処理対象の配列
Function Length(ByVal arr As Variant) As Long
On Error GoTo EMPTY_ARR
    If IsArray(arr) Then
        Length = UBound(arr) + (1 - LBound(arr))
    Else
        Length = -1
    End If
    Exit Function
EMPTY_ARR:
    If Err.Number = 9 Then
        ' インデックス範囲外エラー
        Length = 0
    End If
End Function

戻り値「-1」のケースについて

動的配列の宣言は、Dim arr()でもDim arr(またはDim arr As Variant)でも可能です。
ポイントはDim arrで、宣言した後にRedimで配列型として初期化が可能です。
この場合、初期化前は配列ではありません。配列としてLBound(arr)等の処理は実行時エラー「13」(型不正)となります。
そのため、配列でない(初期化前の)引数の場合は、「-1」を返しています。(必要に応じて戻り値を「0」にしても)
引数に初期化前の配列変数を渡さないことを保証できるのであれば不要な分岐ですが、汎用さを確保するためには必要です。
Function Length(Byval arr() As Variant) As Longのように配列型で宣言できればいいんですけども。

2. 動的配列の最後に要素を追加

動的配列はRedimで要素数を変更できます。
無条件でRedim arr(0)等できない場合、初めて配列に要素を追加するタイミングで要素数を増やす必要があります。
新規に配列を作り直すわけではないので、FunctionではなくSubにし、操作したい配列はByRefで参照渡しにしています。
※この記事で紹介しているLengthプロシージャを組み合わせて使っています。

' 動的配列の最後に要素を追加
' arr：追加先の配列
' value：追加する要素
' firstIdx：空の場合に先頭とするインデックス
Sub AddLast(ByRef arr As Variant, ByVal value As Variant, Optional ByVal firstIdx As Long = 0)
    If IsEmpty(arr) Or Length(arr) < 1 Then
        ' 初期化前または要素数=0の場合
        ReDim arr(firstIdx To firstIdx)
    Else
        ReDim Preserve arr(LBound(arr) To UBound(arr) + 1)
    End If
    arr(UBound(arr)) = value
End Sub

初期化前、または要素数が0の場合について

空の配列変数に対して、LBound関数およびUBound関数は、実行時エラー「9」が発生します。なので空判定には使用できません。
Dim arr()で宣言している配列変数は、Redimで初期化前でもIsEmpty(arr)の結果がFalseになります。
そのため、IsEmpty(arr)だけではなく、Sgn(arr) = 0または(Not Not arr) = 0でも判定が必要です。
これで解決！と思いうじゃないですか。
でも、要素数が1以上の()なし(型指定なしまたはVariant型)で宣言した引数を渡すと、実行時エラー「13」が発生します…

そんなわけで上で説明しているLengthプロシージャを使用しているのですが、ループ内で大量に呼ぶと何回かに1回4秒くらいかかって激重・激遅になります。
(大量に呼び出して処理時間をDebug.Printしてみたら、0秒 Or 3.9秒がランダムに出力された…何でばらつく？？)
ですので、実際使用する場合は、呼び出し元の配列変数の宣言時の型と引数の配列の空判定方法の組み合わせを、以下のどちらかのパターンに寄せたほうがいいです。

1. 配列変数をDim arr As Variantのように()なしのVariant型で宣言し、空判定をIsEmpty(arr)関数で行う
2. 配列変数をDim arr() As 型のように()ありで宣言し、空判定をSgn(arr) = 0または(Not Not arr) = 0で行う

私は大体1ですね。IsEmpty(arr)は見た目で何やってるかわかりやすいので。
しかし何つー仕様だMicr○soft。Variant型の配列としての空判定は必ずOn Error GoTo ～使えってか…()なしならRedimで配列として初期化できないようにしろよお…
可変長配列は、セルに直接代入できないけどCollectionオブジェクトやDictionaryオブジェクト、またはVB.NetのArrayListオブジェクト使うって手もあるんですけどね。
これらはNewしたらAddで追加できるので、もろもろの考慮が不要です。

3. ジャグ配列(入れ子の配列)を二次元配列に変換

ループでセルひとつひとつに出力すると重いので、セルに出力する処理は、配列を作って1回でセルに出力することが多いです。そんな時に使用する多次元配列。
VBAのいう多次元配列は、Java等の多次元配列と違い、ジャグ配列とは異なります。(ジャグ配列だとセルにそのまま出力不可)
ただ、VBAの多次元配列って、可変長なのは末尾の次元(ジャグ配列でいう入れ子の一番内側)のみなんですよ。
CSVを読み込んで処理して必要な行だけセルに出す、なんてありがちな処理は、予め出力行数がわかってないと配列を宣言できません。
かといってCSVがクソデカファイルだとFileSystemObjectを使用して行数だけを取得するにしても、処理時間がかかる。
行ごとに条件判定して出力有無が決まるとかだと、予め行数は取得できません。
なので、ジャグ配列で処理後、セルへの出力時に二次元配列に変換するのが一番わかりやすいなって気がします。可読性と速さのバランスが一番いいと思いますし。
そんな時に使用するのがこのプロシージャです。

具体的な使用例はこちら→【VBA】多次元配列の落とし穴

' ジャグ配列を二次元配列に変換
' srcArr：元となるジャグ配列
Function Conv2DemintionalArray(ByVal srcArr As Variant) As Variant
    Dim pBgnIdx As Long: pBgnIdx = LBound(srcArr)
    Dim cArr As Variant: cArr = srcArr(pBgnIdx)
    Dim result As Variant: ReDim result(pBgnIdx To UBound(srcArr), LBound(cArr) To UBound(cArr))
    Dim i As Long: For i = pBgnIdx To UBound(srcArr)
        Dim j As Long: For j = LBound(cArr) To UBound(cArr)
            result(i, j) = srcArr(i)(j)
        Next
    Next
    Conv2DemintionalArray = result
End Function

4. 指定した要素が配列に含まれているかチェック

contains的な動きをするプロシージャです。単純にFor Eachでぐるぐる回して一致したらそこで抜けるだけ。
プリミティブな値が含まれているかどうかをチェックするなら、都度書くよりもプロシージャのほうがソースがすっきりするかと。
このプロシージャ、応用が利きます。
形だけ流用する例を挙げれば、WorkSheetsコレクションに指定のシート名が含まれているかのチェック処理とか。
よくあるやつ。

' 指定した要素が配列に含まれているかチェック
' checker：チェック対象
' arr：チェック先の配列
Function ContainsArray(ByVal checker As Variant, ByVal arr As Variant) As Boolean
    ContainsArray = False
    Dim item As Variant: For Each item In arr
        If item = checker Then
            ContainsArray = True
            Exit Function
        End If
    Next
End Function

おすすめの使い道

実は配列処理としてよりも「checkerがAまたはBの場合」みたいな分岐でよく使うことが多いです。
If checker = A Or checker = B Thenを、If ContainsArray(checker, Array(A, B)) Thenのように記述できます。
Or条件が増えれば増えるほどこっちのが楽だと思います。
あと逆パターンの「AまたはBがcheckerの場合」にも使えますね。
たまにこの読み替えができない方を見かけます。
が、仕様に動けば、ソースは設計書と完全一致させる必要ないかと…コーディングってそういうことだと思うんですが。

上記のような使い方だけの場合、引数arrを可変長引数にしてParamArray arr() As Variantにするのもアリです。
そうすると呼出し元でArray関数使って配列にする必要がなくなりますね。
あ、引数の型がVariant型なのは、型を気にせずに使い回せるように、です。引数の編集をしない処理なので。

応用編～指定した要素が含まれている数を取得

ちなみにarrの要素がすべてcheckerに一致するかチェックをしたい場合、戻り値をBooleanではなくLongにして、一致した件数を返すようにします。
「含まれているかチェック」なら戻り値が0件以外、「すべて一致かチェック」なら戻り値がarrの要素数と一緒かどうかを見れば、そういうチェックに使えますね。

' 指定した値に一致した配列に含まれる値の数を取得
' checker：チェック対象
' arr：チェック先の配列
Function CountEquals(ByVal chkTarget As Variant, ByVal values As Variant) As Long
    CountEquals = 0
    Dim value As Variant: For Each value In values
        If chkTarget = value Then
            CountEquals = CountEquals + 1
        End If
    Next
End Function

こちらも引数arrを可変長引数にしてParamArray arr() As Variantにするのもアリだと思います。

5. 複数配列の要素を順番に結合した1つの配列を作成

2重ループを回して先頭インデックスが「0」の新しい動的配列を作成します。
まあParamArray使うとByRefがつけられず値渡しでしか渡せないので、新規の配列で返却せざるを得ないのですが。

' 複数配列の要素を順番に結合した1つの配列を作成
' values：結合する配列
Function UnionArray(ParamArray values() As Variant) As Variant
    If UBound(values) < 0 Then
        Exit Function
    End If
    Dim newArr As Variant: newArr = Empty
    Dim idx As Long: idx = 0
    Dim outside As Variant: For Each outside In values
        If IsEmpty(newArr) Then
            ReDim newArr(UBound(outside))
        Else
            ReDim Preserve newArr(UBound(newArr) + UBound(outside) + 1)
        End If
        Dim inside As Variant: For Each inside In outside
            newArr(idx) = inside
            idx = idx + 1
        Next
    Next
    UnionArray = newArr
End Function

…変数名がちょっと微妙だな…

newArrに詰めている部分は、この記事で紹介しているAddLastプロシージャを使うと、もっとすっきり書けます。
汎用的にするために、なるべく各プロシージャが単独で動くように記述していますが、併せて使うなら書き換えたほうがすっきりします。

' newArrの宣言～外側のNextまでをAddLast利用に書き換え
Dim newArr As Variant: newArr = Empty
Dim outside As Variant: For Each outside In values
    Dim inside As Variant: For Each inside In outside
        Call AddLast(newArr, inside)
    Next
Next

6. 指定したインデックスに要素を追加(した配列を作成)

Subで元の配列をByRefで渡すのではなくFunctionでByValで渡しているのは、その配列が静的か動的かを分岐せずに処理を行うためです。
なので一律で引数とは別の新規の配列を返すようにしています。静的配列はRedimできないので。

以下、注意点です。

• 指定したインデックス＜元の配列の先頭インデックスの場合、先頭の要素に追加(先頭のインデックスは、元の配列から変更なし)
• 指定したインデックス＞元の配列の末尾インデックスの場合、末尾に追加

' 指定したインデックスに要素を追加
' srcArr：元の配列
' addIdx：追加位置のインデックス
' value：追加する値
Function AddItem2Idx(ByVal srcArr As Variant, ByVal addIdx As Long, ByVal value As Variant) As Variant
    Dim newArr() As Variant: ReDim newArr(LBound(srcArr) To UBound(srcArr) + 1)
    Dim idx As Long: idx = LBound(srcArr)
    Dim item As Variant: For Each item In srcArr
        If (addIdx < LBound(srcArr) And idx = LBound(srcArr)) Or idx = addIdx Then
            newArr(idx) = value
            idx = idx + 1
        End If
        newArr(idx) = item
        idx = idx + 1
    Next
    If UBound(srcArr) < addIdx Then
        newArr(UBound(newArr)) = value
    End If
    AddItem2Idx = newArr
End Function

この記事で紹介しているAddLastプロシージャを使った方がもっと簡単に書けます。
newArrのサイズを先にRedimする必要も、idxをループ内でインクリメントする必要もないので。

' newArrの宣言～最後のIf文までをAddLast利用に書き換え
Dim newArr As Variant: newArr = Empty
Dim idx As Long: For idx = LBound(srcArr) To UBound(srcArr)
    If (addIdx < LBound(srcArr) And idx = LBound(srcArr)) Or idx = addIdx Then
        Call AddLast(newArr, value, LBound(srcArr))
    End If
    Call AddLast(newArr, srcArr(idx), LBound(srcArr))
Next
If UBound(srcArr) < addIdx Then
    Call AddLast(newArr, value)
End If

7. 指定したインデックスの要素を削除(した配列を作成)

上のAddItem2Idxプロシージャの逆？派生？バージョン。
なので、SubでByRefではなく、FunctionでByValです。

以下、注意点です。

• 指定したインデックス＜元の配列の先頭インデックスの場合、先頭の要素を削除(先頭のインデックスは、元の配列から変更なし)
• 指定したインデックス＞元の配列の末尾インデックスの場合、末尾を削除

' 指定したインデックスの要素を削除
' srcArr：元の配列
' rmvIdx：削除位置のインデックス
Function RemoveItem2Idx(ByVal srcArr As Variant, ByVal rmvIdx As Long) As Variant
    Dim newArr() As Variant: ReDim newArr(LBound(srcArr) To UBound(srcArr) - 1)
    Dim srcIdx As Long: srcIdx = LBound(srcArr)
    Dim idx As Long: For idx = LBound(newArr) To UBound(newArr)
        If (rmvIdx < LBound(srcArr) And srcIdx = LBound(srcArr)) Or srcIdx = rmvIdx Then
            srcIdx = srcIdx + 1
        End If
        newArr(idx) = srcArr(srcIdx)
        srcIdx = srcIdx + 1
    Next
    RemoveItem2Idx = newArr
End Function

この記事で紹介しているAddLastプロシージャを使った版はこちら。

' newArrの宣言～NextまでをAddLast利用に書き換え
Dim newArr As Variant: newArr = Empty
Dim idx As Long: For idx = LBound(srcArr) To UBound(srcArr)
    If Not ((rmvIdx < LBound(srcArr) And idx = LBound(srcArr)) _
            Or (UBound(srcArr) < rmvIdx And idx = UBound(srcArr)) _
            Or idx = rmvIdx) Then
        Call AddLast(newArr, srcArr(idx), LBound(srcArr))
    End If
Next

8. 配列の一部分を切り出して新規の配列を作成

元の配列の指定したインデックスの範囲を、別の配列として返却します。
開始・終了インデックスの引数を省略した場合、それぞれ「0」を引数に渡した扱いになります。
ですので、両方のインデックスを省略すると元の配列の先頭インデックスの値だけが入った配列になります。

以下、注意点です。

• 終了インデックス < 開始インデックスの場合、入れ替えて処理を行う
• 開始インデックスが元の配列のインデックスの範囲外の場合、先頭からとする
• 終了インデックスが元の配列のインデックスの範囲外の場合、末尾までとする

' 元の配列の指定されたインデックスの範囲で新規の配列を作成
' srcArr：元の配列
' bgnIdx：開始インデックス(初期値：0)
' endIdx：終了インデックス(初期値：0)
Function SubArray(ByVal srcArr As Variant, Optional ByVal bgnIdx As Long = 0, Optional ByVal endIdx As Long = 0) As Variant
    If endIdx < bgnIdx Then
        Dim wk As Long: wk = bgnIdx
        bgnIdx = endIdx
        endIdx = wk
    End If
    If bgnIdx < LBound(srcArr) Or UBound(srcArr) < bgnIdx Then
        bgnIdx = LBound(srcArr)
    End If
    If endIdx < LBound(srcArr) Or UBound(srcArr) < endIdx Then
        endIdx = UBound(srcArr)
    End If
    Dim newArr As Variant: ReDim newArr(0 To UBound(srcArr) - ((bgnIdx - LBound(srcArr)) + (UBound(srcArr) - endIdx)))
    Dim idx As Long: idx = LBound(newArr)
    Dim srcIdx As Long: For srcIdx = bgnIdx To endIdx
        newArr(idx) = srcArr(srcIdx)
        idx = idx + 1
    Next
    SubArray = newArr
End Function

開始/終了インデックスが省略された場合、それぞれLbound(srcArr)、UBound(srcArr)にするつもりだったんですよ。
でも、Longの引数は省略すると「0」になっちゃって…意図的に渡したのか省略されたのかが判別不可能で…
コード上は可読性を優先してOptionalのデフォルト値を明示しています。

この記事で紹介しているAddLastプロシージャを使った版はこちら。
ちなみにAddLastの第三引数を省略せずにbgnIdxを渡すと、「0」からではなく指定した範囲のインデックスの範囲そのままの配列が返却されます。

' newArrの宣言～NextまでをAddLast利用に書き換え
Dim newArr As Variant: newArr = Empty
Dim srcIdx As Long: For srcIdx = bgnIdx To endIdx
    Call AddLast(newArr, srcArr(srcIdx))
Next

9. 要素の順番を逆順にした配列を作成

インデックスは元の配列を維持したまま、要素だけを逆順にした配列を作成し、返却します。
FunctionでByValなので、元の配列は変更しません。

' 要素の順番を逆順にした配列を作成
' srcArr：元の配列
Function ReverseArray(ByVal srcArr As Variant) As Variant
    Dim newArr As Variant: ReDim newArr(LBound(srcArr) To UBound(srcArr))
    Dim newIdx As Long: newIdx = LBound(newArr)
    Dim i As Long: For i = UBound(srcArr) To LBound(srcArr) Step -1
        newArr(newIdx) = srcArr(i)
        newIdx = newIdx + 1
    Next
    ReverseArray = newArr
End Function

インデックスを0オリジンにしたい場合、newArrを宣言している行を、下記のように記述します。

Dim newArr As Variant: ReDim newArr(0 To (UBound(srcArr) + (1 - LBound(srcArr))) - 1)

例のごとく、この記事で紹介しているAddLastプロシージャを使った版はこちら。
インデックスを0オリジンにしたい場合、AddLastの第3引数を省略してください。

' newArrの宣言～NextまでをAddLast利用に書き換え
Dim newArr As Variant: newArr = Empty
Dim i As Long: For i = UBound(srcArr) To LBound(srcArr) Step -1
    Call AddLast(newArr, srcArr(i), LBound(srcArr))
Next

10. 配列同士の比較

配列を2つ渡して、配列の要素の値が等しいかどうかをチェックします。
いずれかの引数が配列以外、または2つの配列の要素数が異なる場合、値をチェックする前に不一致と見做してFalseを返却します。

下記A、Bパターンそれぞれ配列の要素数を取得している箇所は、Lengthプロシージャに書き換えることも可能です。
その場合、If (UBound(arr1) + (1 - LBound(arr1))) <> (UBound(arr2) + (1 - LBound(arr2))) ThenをIf Length(arr1) <> Length(arr2) Thenにします。

A. 要素の順番も含めた比較

引数の2つの配列において、先頭の要素から順に比較します。
不一致の要素が出てきた時点でFalseを返却します。

• 引数arr1がArray("ABC", "123", "abc")の場合
  • 戻り値：True　引数arr2がArray("ABC", "123", "abc")(完全一致)
  • 戻り値：False　引数arr2がArray("abc", "ABC", "123")(順番不一致)やArray("ＡＢＣ", "321", "ABC")(値不一致)

' 要素の順番も含めた配列同士の値の比較
' arr1：配列1
' arr2：配列2
Function EqualsArray(ByVal arr1 As Variant, ByVal arr2 As Variant) As Boolean
    EqualsArray = False
    If Not (IsArray(arr1) And IsArray(arr2)) Then
        Exit Function
    End If
    If (UBound(arr1) + (1 - LBound(arr1))) <> (UBound(arr2) + (1 - LBound(arr2))) Then
        Exit Function
    End If
    Dim idxDiff As Long: idxDiff = LBound(arr2) - LBound(arr1)
    Dim i As Long: For i = LBound(arr1) To UBound(arr1)
        If arr1(i) <> arr2(i + idxDiff) Then
            Exit Function
        End If
    Next
    EqualsArray = True
End Function

B. 要素の順番は含めず比較

arr1の先頭から、arr2に要素が含まれているかチェックします。
arr2にない要素が出てきた時点でFalseを返却します。

• 引数arr1がArray("ABC", "123", "abc")の場合
  • 戻り値：True　引数arr2がArray("ABC", "123", "abc")(完全一致)やArray("abc", "ABC", "123")(順番不一致)
  • 戻り値：False　引数arr2がやArray("ＡＢＣ", "321", "ABC")(値不一致)

' 要素の順番は含めない配列同士の値の比較
' arr1：配列1
' arr2：配列2
Function EqualsArray2(ByVal arr1 As Variant, ByVal arr2 As Variant) As Boolean
    EqualsArray2 = False
    If Not (IsArray(arr1) And IsArray(arr2)) Then
        Exit Function
    End If
    If (UBound(arr1) + (1 - LBound(arr1))) <> (UBound(arr2) + (1 - LBound(arr2))) Then
        Exit Function
    End If
    Dim item1 As Variant: For Each item1 In arr1
        Dim isMatch As Boolean: isMatch = False
        Dim item2 As Variant: For Each item2 In arr2
            If item1 = item2 Then
                isMatch = True
                Exit For
            End If
        Next
        If Not isMatch Then
            Exit Function
        End If
    Next
    EqualsArray2 = True
End Function

要素順は含めない比較(パターンBEqualsArray2)は、ContainsArrayプロシージャを使うともっと簡単に書けます。

' For文の開始～終了までをContainsArray利用に書き換え
Dim item1 As Variant: For Each item1 In arr1
    Dim isMatch As Boolean: isMatch = False
    If Not ContainsArray(item1, arr2) Then
        Exit Function
    End If
Next

11. 動的配列としてコピー

静的配列は、要素数の増減ができません。要素数を変更したい場合は、動的配列としてコピーすればいいです。
※インデックスは元の配列と同じになります。

' 静的配列を動的配列に変換
' srcArr：元の配列
Function Copy2DynamicArray(ByVal srcArr As Variant) As Variant
    Dim newArr As Variant: ReDim newArr(LBound(srcArr) To UBound(srcArr))
    Dim i As Long: For i = LBound(srcArr) To UBound(srcArr)
        newArr(i) = srcArr(i)
    Next
    Copy2DynamicArray = newArr
End Function

例のごとく、この記事で紹介しているAddLastプロシージャを使った版はこちら。
インデックスを0オリジンにしたい場合、AddLastの第3引数を省略してください。

' newArrの宣言～NextまでをAddLast利用に書き換え
Dim newArr As Variant: newArr = Empty
Dim item As Variant: For Each item In srcArr
    Call AddLast(newArr, item, LBound(srcArr))
Next

---

VBA書くなら配列の処理は頻出だと思うので、どうにか覚えていくしかないんですよね…