【超便利】VBAの配列操作の独自関数を大公開

VBAの標準関数では、配列操作が少ないため、配列に関する独自の関数を開発しました。
引数に配列を含む関数が多いため、配列でない引数を指定した場合のエラー表示も

前提

以下に挙げる関数には、イミディエイトウィンドウにログを表示させるため、以下の独自関数を利用します。Debug.Printと打ち込むのが意外と面倒で、他のプログラミング言語と同じように利用可能なlogという関数を用意します。

Sub log(txt)
    Debug.Print (txt)
End Sub

配列の要素を追加する

Function ArrAdd(arr, item, Optional d = 0)
    If Not IsArray(arr) Then
        log ("第一引数には配列を指定してください")
    End If
    n = UBound(arr)
    ReDim Preserve arr(UBound(arr) - LBound(arr) + 1)
    arr(UBound(arr) - LBound(arr) + 1) = item
    ArrAdd = arr
End Function

配列の情報をイミディエイトウインドウで表示

Sub ArrInfo(arr)
    If Not IsArray(arr) Then
        log ("引数には配列を指定してください")
    End If
    log (Join(arr))
End Sub

配列の次元数を取得

Function getArrD(arr)
    On Error Resume Next
    Do While Err.Number = 0
        i = i + 1
        TempData = UBound(arr, i)
    Loop
    On Error GoTo 0
    getArrD = i - 1
End Function

行と列の入れ替え

Function TArr(arr)
    If Not IsArray(arr) Then
        log ("引数には配列を指定してください")
    Else
        TArr = WorksheetFunction.Transpose(arr)
    End If
End Function

2次元配列の1行を1次元配列にする

Function Arr21R(arg, row)
    Dim arr2
    arr2 = arg
    If Not IsArray(arr2) Then
        log ("Arr21R関数の引数には配列を指定してください")
    Else
        ReDim arr1(1 To UBound(arr2, 2)) As Variant
        Dim i As Long
        For i = LBound(arr2, 2) To UBound(arr2, 2)
            arr1(i) = arr2(row, i)
        Next
        Arr21R = arr1
    End If
End Function

1次元配列から一部の配列を取り出す

Function PartOfArr(arr1, r1, r2)
    ReDim arr(1 To r2 - r1 + 1)
    Dim i
    If Not IsArray(arr1) Then
        log ("PartOfArr関数の引数には配列を指定してください")
    Else
        For i = r1 To r2
            arr(i - r1 + 1) = arr1(i)
        Next
    End If
    PartOfArr = arr
End Function

2次元配列から一部の配列を取り出す

Function PartOfArr2(arr2, r1, c1, r2, c2)
    ReDim arr(1 To r2 - r1 + 1, 1 To c2 - c1 + 1)
    Dim i, j
    If Not IsArray(arr2) Then
        log ("PartOfArr2関数の引数には配列を指定してください")
    Else
        For i = r1 To r2
            For j = c1 To c2
                arr(i - r1 + 1, j - c1 + 1) = arr2(i, j)
            Next
        Next
    End If
    PartOfArr2 = arr
End Function