配列からの値貼り付けに関する覚書 ③ ところどころに数式を含むテーブルに、レコードを丸ごとベタッと貼り付けたい

先日、四苦八苦した体験談からのご紹介。

例えば、こんなテーブルがあるとする。

このテーブル、実は年齢の列だけ数式がセットされている。

このような条件のもと、レコードを追加したい。

例えば、この追加レコードを配列に格納して、テーブルに
ベタっと追加したらどうなるか。

Sub Test()
    
    ' 貼り付け先。
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
    
    ' 貼り付け元。
    Dim SourceArray As Variant
        SourceArray = Range("A17:D18")
    
    ' テーブルに行追加。
    Dim LastRow As Excel.ListRow
    Set LastRow = Tb.ListRows.Add
    
    ' 最終行を配列の行数だけ拡張した範囲に貼り付け。
        LastRow.Range.Resize(UBound(SourceArray)) = SourceArray

End Sub

結果は、こんな感じ。貼り付けたレコードのうち、一つ目だけ
空白であることが律儀に守られている。

ならば、一行目だけ数式を無理矢理セットしたらどうかと考えた。

Sub Test()
    
    ' 貼り付け先。
    Dim Tb As Excel.ListObject
    Set Tb = ActiveSheet.ListObjects(1)
    
    ' 貼り付け元。
    Dim SourceArray As Variant
        SourceArray = Range("A17:D18")
    
    ' テーブルに行追加。
    Dim LastRow As Excel.ListRow
    Set LastRow = Tb.ListRows.Add
    
    ' 追加された行から数式を取得。
    Dim ColumnIndex As Long
        For ColumnIndex = 1 To Tb.ListColumns.Count
            If LastRow.Range(ColumnIndex).HasFormula Then
                SourceArray(1, ColumnIndex) = LastRow.Range(ColumnIndex).Formula
            End If
        Next
        
    ' 最終行を配列の行数だけ拡張した範囲に貼り付け。
        LastRow.Range.Resize(UBound(SourceArray)) = SourceArray

End Sub

結果、今度はちゃんと数式がセットされた。

数式を取得してセットする手間はあるが、ベタっと貼り付けられるので
なかなか便利だと思った。実際この方法を採用するかどうかは、いつも
のごとく、時と場合と皆様のお好みで。

参考まで。