二次元配列で、最後尾に新たな一行または一列を追加

昨日は、二次元配列での列編集に挑戦した。
infoment.hatenablog.com

行に対して作りためた様々を、列に横展開。これでまた、一気に充実した。しかし今までのものは全て、既存データのやりくりでしかない。そこで今回は、新規データの追加に挑戦する。

今回挑戦するのは、以下の３つ。

1. 配列の最終行に一行追加。
2. 配列の最終列に一列追加。
3. 配列を指定範囲に貼り付け。

新たなデータを配列の途中に差し込んでも良いのだが、そうなると、どちらにシフトするかなどの条件分岐がややこしくなる。似たような機能を沢山作るのも面倒なので、取り敢えず末尾に追加し、後は作成済みの機能で遣り繰りすることにした。

クラスモジュール（ArrayEditClass）

行追加の場合。

' 最後尾に行を追加。
Public Function RowAdd(arr As Variant) As Variant
    
    ' 最後尾追加用に行を拡張。
    Dim iMax As Long
        iMax = rMax + 1
        source_array = RowInsert(iMax - 1, xlUp)
        
    Dim a As Variant
    Dim col As Collection
    Set col = New Collection
    For Each a In arr
        col.Add a
    Next
    
    ' 最後尾にデータをセット。
    i = 1
    For c = cMin To cMax
        source_array(iMax, c) = col.Item(i)
        i = i + 1
    Next

    ' 最後尾に出来てしまう余分な一行を削除。
    RowAdd = RowDelete(rMax)
End Function

列追加の場合。行の場合とほぼ同じ。

' 最後尾に列を追加。
Public Function ColumnAdd(arr As Variant) As Variant
    
    ' 最後尾追加用に列を拡張。
    Dim iMax As Long
        iMax = cMax + 1
        source_array = ColumnInsert(iMax - 1, xlToLeft)
        
    Dim a As Variant
    Dim col As Collection
    Set col = New Collection
    For Each a In arr
        col.Add a
    Next
    
    ' 最後尾にデータをセット。
    i = 1
    For r = rMin To rMax
        source_array(r, iMax) = col.Item(i)
        i = i + 1
    Next

    ' 最後尾に出来てしまう余分な一列を削除。
    ColumnAdd = ColumnDelete(cMax)
End Function

最後に、貼り付け用プロシージャを作成。こちらは、

1. 単純貼り付け
2. テーブルとして貼り付け

の二択とした。テーブル名は都度指定してもらっても良いのだが、面倒臭がられそうなので、日付をテーブル名とすることで重複を避けた。また、戻り値をListObjectにしたので、そのまま変数にセットすることも可能だ。

' シートへの貼り付け
Enum PasteType
    ptRange
    ptTable
End Enum

' 配列をシートへ貼り付け。
Public Function PasteArray(destination As Range, _
                  Optional paste_type As PasteType = ptRange) As ListObject

    Dim TargetRange As Range
    Set TargetRange = destination.Resize(rMax - rMin + 1, cMax - cMin + 1)
        TargetRange = source_array
    
    If paste_type = ptTable Then
        Dim TableName As String
            TableName = "Table_" & Format(Now, "yyyymmdd_hhmmss")
    
            ActiveSheet.ListObjects.Add(xlSrcRange, _
                                        TargetRange, _
                                        , _
                                        xlYes).Name = TableName
            Set PasteArray = ActiveSheet.ListObjects(TableName)
    End If

End Function

それでは、テストしてみよう。
今回も先日と同様、北陸三県で表を作ってみる。
↓ 既存データがこちら。

北から順に並んでいるだけで、他意は無い。それで、まず４行目に石川県を追加する。次いで、３列目に県庁所在地を追加する。これら追加した結果を、テーブルとして貼り付ける。

' 配列をシートへ貼り付け。
Public Function PasteArray(destination As Range, _
                  Optional paste_type As PasteType = ptRange) As ListObject

    Dim TargetRange As Range
    Set TargetRange = destination.Resize(rMax - rMin + 1, cMax - cMin + 1)
        TargetRange = source_array
    
    If paste_type = ptTable Then
        Dim TableName As String
            TableName = "Table_" & Format(Now, "yyyymmdd_hhmmss")
    
            ActiveSheet.ListObjects.Add(xlSrcRange, _
                                        TargetRange, _
                                        , _
                                        xlYes).Name = TableName
            Set PasteArray = ActiveSheet.ListObjects(TableName)
    End If

End Function

結果は、↓ こちら。

テスト結果は良好、次回に続きます。

参考まで。