二つの配列を結合する関数

昨日からの流れで何となく、配列を結合する関数を作ってみたくなった。

↓ こんな感じで横並びに繋げるか、

或いは、↓ こんな感じで縦並びに繋げるか。

場合分けを考えていたら、ややこしくなってきたので、今回は（個人的に）禁断の
「一旦作業用シートを作って、張り付けて、用が済んだら削除する」
でやってみた。

まずは、以前から何度か登場している「配列をシートに貼り付ける関数」を再掲。

'［用　途］
'   配列の次元数取得
'
'［引　数］
'   arr As Variant  配列
'
'［戻り値］
'   正常終了    配列の次元数
'   -1の場合    異常終了　※つまり、seqは配列ではない

Private Function GetArrayDimension(arr As Variant) As Long

    If IsArray(arr) = False Then
        GetArrayDimension = -1
        Exit Function
    End If

    ' 配列の次元数を取得。

    Dim i As Long
    Dim TempNumber As Long

        On Error Resume Next
        Do While Err.Number = 0
            i = i + 1
            TempNumber = UBound(arr, i)
        Loop

        GetArrayDimension = i - 1

End Function

'［用　途］
'   指定セルに配列を貼り付ける。

'［引　数］
'   target_range As Range     配列を貼り付けるセル
'   sorce_array As Variant   貼り付けられる配列

'［戻り値］
'    0の場合    正常終了
'   -1の場合    異常終了　※target_arrayは配列ではない。
'   -2の場合    異常終了　※配列の次元数が３以上。

Function PasteArray(target_range As Range, _
                    sorce_array As Variant) As Long

    Dim R As Long     ' 貼り付ける行数
    Dim C As Long     ' 貼り付ける列数

    ' 配列の次元数取得
        PasteArray = GetArrayDimension(sorce_array)
        If PasteArray = -1 Then
            Exit Function
        Else
            Dim DimensionNumber As Long
                DimensionNumber = PasteArray
        End If

    ' 貼り付け行数の取得。
    Dim rMax As Long
        rMax = UBound(sorce_array) - LBound(sorce_array) + 1

        Select Case DimensionNumber

        ' 一次配列の場合。
            Case 1
                target_range.Resize(rMax) = WorksheetFunction.Transpose(sorce_array)

        ' 二次配列の場合。
            Case 2
                Dim cMax As Long
                    cMax = UBound(sorce_array, 2) - LBound(sorce_array, 2) + 1
                    target_range.Resize(rMax, cMax) = sorce_array

        ' 三次以上の場合。　※未対応。
            Case Else
                PasteArray = -2

        End Select

End Function

次いで、配列を結合するユーザー定義関数がこちら。横にくっつけるか、縦にくっつけるか、選択のためのEnum付で。

Enum JoinDirection
    jdHolizontal
    jdVertical
End Enum

'［用　途］
'   二つの配列を結合する

'［引　数］
'   arr_1 As Variant　一つ目の配列
'   arr_2 As Vairant　二つ目の配列

'［戻り値］
'   arr_1 ⇒ arr_2 の順に結合した配列
'   ※インデックスは全て１始まりとする。

Public Function JoinArray(arr_1 As Variant, _
                          arr_2 As Variant, _
                 Optional join_direction As JoinDirection = jdHolizontal) As Variant

    On Error GoTo er1:

    Application.ScreenUpdating = False
    Dim Sh(1) As Worksheet
    Set Sh(0) = ActiveSheet

        Sheets.Add After:=Sheets(Sheets.Count)

    Set Sh(1) = ActiveSheet

        PasteArray Sh(1).Range("A1"), arr_1

    Dim PasteTarget As Range
        Select Case join_direction
            Case jdHolizontal
                Set PasteTarget = Sh(1).Cells(1, Sh (1).UsedRange.Columns.Count + 1)
            Case jdVertical
                Set PasteTarget = Sh(1).Cells(Sh(1).UsedRange.Rows.Count + 1, 1)
        End Select

        PasteArray PasteTarget, arr_2

        JoinArray = Sh(1).UsedRange

    Application.DisplayAlerts = False
        Sh(1).Delete
    Application.DisplayAlerts = True
        Sh(0).Select

    Application.ScreenUpdating = True
    Exit Function

er1:
    Application.ScreenUpdating = True

End Function

早速、テストしてみよう。
まずは、データを準備する。

縦と横に、それぞれ結合してみた。

Sub test()
    Dim arr_1 As Variant: arr_1 = Range("A1:B4")
    Dim arr_2 As Variant: arr_2 = Range("D1:E4")
    Dim arr_3 As Variant: arr_3 = Range("G1:H2")
    
    Dim arr_4 As Variant
        arr_4 = JoinArray(arr_1, arr_2, jdHolizontal)
    
    Dim arr_5 As Variant
        arr_5 = JoinArray(arr_1, arr_3, jdVertical)
        
    PasteArray Range("A6"), arr_4
    PasteArray Range("A12"), arr_5
End Sub

結果がこちら。

一応、想定したとおりに動きはしたが、何だかスッキリしない。一旦シートに貼り付けた時点で、何だか「負けた感」がある。

もっと上手い方法が無いか、探してみます。

参考まで。