【Excel VBA】テーブルへCSVのデータを一括で追加する【Excel 2019】

ExcelのテーブルをVBAで操作する機会があったので備忘録として。
※3年以上前に限定公開していた記事を公開します。Excelのバージョンによっては動かないことが想定されますので、動いた/動かないの報告を頂けますと大変助かります。

# 環境
Excel 2019

# TL;DR
[まとめて関数化](#まとめて関数化)に飛ぶと良い。

# テーブルを取得
```vb:vba

Dim table as ListObject '取得用変数
'シート名SheetName, テーブル名TableNameとする

'以下(1)~(4)のどれでも良い
'(1) シートとセル位置から取得
Set table = Sheets("SheetName").Range("A1").ListObject

'(2) テーブル名のみから取得
Set table = Range("TableName").ListObject

'(3) シートとテーブルの番号から取得
'呼び出しているメソッド名が ListObject"s" であることに注意
Set table = Sheets("SheetName").ListObjects(1)

'(4) シートとテーブル名から取得
'呼び出しているメソッド名が ListObject"s" であることに注意
Set table = Sheets("SheetName").ListObjects("TableName")


```
テーブルはListObjectである。
個人的な結論から言うと、**テーブル名はブック単位で一意**なので、`Range`メソッドにテーブル名を入れるだけで完結する「(2) テーブル名のみから取得」 が利用しやすい。
(1), (2)は`Range`オブジェクトの`ListObject`メソッドが、その範囲に存在しているテーブルの`ListObject`を返している。
(3), (4)は`ListObjects`コレクションの戻り値(正確には`ListObjects.Item`メソッドだが`Item`は省略可能)が`ListObject`になる。`ListObjects`は親オブジェクトが`WorkSheet`オブジェクトなので、VBAで取得する際は`Sheets`/`Worksheets`コレクションで指定する。なお省略した場合は`ActiveSheet`になる。

私はテーブルをテーブル名で管理したい(その方が考えやすい)ので、シートを限定せずテーブルに直接アクセスできる(2)を使う機会が多い。
(1),(3)はテーブル名よりもシート名やセル位置などによる管理に重点を置いている。例えば`ListObjects.Add`メソッドでテーブルを追加し、`Name`プロパティを空欄にしている場合などは(1), (3)のほうが楽だろう。
(4)は(2)で代替できるのでほぼ使わない。

# テーブルの所属するシートを取得
```vb:vba
Dim sheet As Worksheet
'親を取得
Set sheet = Range("TableName").ListObject.Parent
```

`ListObjects`の親が`WorkSheet`であるため、この方法で取得できる。

# テーブルにデータを一括で追加
```vb:vba
Dim table As ListObject
'テーブル名TableNameとする
Set table = Range("TableName").ListObject

'テーブルが空だったならば、空データを追加してフラグを立てる
Dim is_empty As Boolean
If table.ListRows.Count = 0 Then
    table.ListRows.Add
    is_empty = True
End If

'''データ書込処理ここから'''
(省略)    'テーブルの1行下のデータセルに追加したいデータを書き込む
'''データ書込処理ここまで'''

'リサイズメソッドでテーブルサイズを変更
table.Resize table.Range.Resize(テーブルの先頭行～追加したデータの最終行までの行数)  '追加行をテーブル範囲に含める

If is_empty = True Then      '追加前のテーブルが空だったならば
    table.ListRows(1).Delete 'データの先頭行(空行)を削除
End If

```

テーブルへの追加メソッドは`ListObject.ListRows.Add`があるが、一行ごとに追加しなければならない。例えばCSVなどから追加するときなどは、Forで一行ごと追加するよりも一括で追加してしまいたくなる。
そこで追加したいデータを既存のテーブルの1つ下の行に書き込み、`ListObject.Resize`メソッドを使って、テーブルの範囲を変更することで追加を達成する。`ListObject.Resize`メソッドに指定する`Range`オブジェクトはテーブルの全体を指したいので、`ListObject.Range.Resize`メソッドで既存のテーブル範囲から追加したデータ範囲を増やす。`Range.Resize`メソッドは第一引数が行数、第二引数が列数の指定であり、省略した引数はもとの範囲から変わらないため、今回は第一引数のみ指定している。


![テーブルのデータ数比較.PNG](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/275801/06c3c300-9e45-6062-c01d-0dce3e48bc11.png)
ただし、ここで注意点がある。既存のテーブルのデータ数が0の場合、Excelのシート上の見た目は「見出し行+空のデータ行」の2行であり、データ数1の状態と同じである(上図参照)。さらに、空のデータ行へVBAから(`ListRows.Add`を使わずに)書き込むことはできない。
そこで、データ数が0の場合(`ListRows.Count = 0`などで判断できる)は場合分けをし、`ListRows.Add`でデータを1つ追加しておく[^1]。追加処理終了後に`ListRows(1).Delete`でデータの先頭行(空データ)を削除してやればよい[^2]。

# CSVからExcelシートへデータを流し込む

```vb:vba

'前略
'''データ書込処理ここから'''
Dim new_data_range As Range
Set new_data_range = table.DataBodyRange.Offset(table.ListRows.Count, 0) '既存データ行の一行下を新しいデータ領域として指定
'※DataBodyRangeは直前で空データを挿入してあるのでNULLにはならない

'CSVデータを追加
'クエリテーブルを利用してCSVを取り込む
Dim csv_path As String
Set csv_path = 取り込みたいCSVファイルのパス

Dim qtCsv As QueryTable
Set qtCsv = table.Parent.QueryTables.Add(
        Connection:="TEXT;" & csv_path, 'テキストファイルを指定し、CSVへのパスを渡す
        Destination:=new_data_range) '書込セルを指定
'↑ table.ParentがWorksheetオブジェクトを指すことを利用している

With qtCsv
    .TextFileParseType = xlDelimited   '区切り文字の形式
    .TextFileCommaDelimiter = True 'カンマ区切りの指定
    .TextFileStartRow = 2 '開始行の指定 見出し行を無視するので2行目から
    .TextFileTextQualifier = xlTextQualifierDoubleQuote '引用符の指定
    .TextFilePlatform = 65001 '文字コード指定 Shift-JIS=932, UTF-8=65001
    .AdjustColumnWidth = False '列幅の自動調節をしない
    .RefreshStyle = xlOverwriteCells '既存データがあっても上書き
    .Refresh BackgroundQuery:=False '上記の設定でQueryTablesオブジェクトを更新し、シート上に出力
End With

'追加したデータの最終行を取得
Dim added_rows_count As Long
added_rows_count = qtCsv.ResultRange.Rows.Count

'QueryTables.Addメソッドで取り込んだCSVとの接続を解除. 
qtCsv.Delete 'ここで削除しないとテーブル化できない
'''データ書込処理ここまで'''

'後略

```
前節で省略した「データ書込処理」の部分。今回はCSVファイルから読み込む。これにはQueryTableを使うと良いようだ。特にダブルクオーテーションなどのエスケープ処理を手書きしなくて良い点と複数の文字コードに対応している点が助かる。
参考:[エクセルVBAでQueryTableオブジェクトを使って高速にCSVを取り込む方法](https://tonari-it.com/excel-vba-csv-querytable/)

まず前処理として書き込むべき領域を探す。Excel VBAの`Range`オブジェクトはワークシート上で`Select`しないなら、左上セルさえ合っていれば実用上は問題ない。
`DataBodyRange`はテーブルの見出し行を含まない領域(の左上)を返す。`ListRows.Count`はデータ行の数を返す。つまり、`DataBodyRange`から`ListRows.Count`分下方向へ`Offset`すれば、テーブルのデータ領域の1つ下を指すことになる。
という訳で`table.DataBodyRange.Offset(table.ListRows.Count, 0)`が「既存のテーブルの一行下」になる。

次に`QueryTable`オブジェクト`qtCsv`を作成する。`QueryTables`コレクションは`Sheet`オブジェクトのメソッドとして存在しているので、シートを「[テーブルの所属するシートを取得](#テーブルの所属するシートを取得)」の方法で取得し、`QueryTables.Add`へ繋げている。
`QueryTables.Add`の必須パラメータは`Connection`と`Destination`である。詳しくは[公式ドキュメント(英語)](https://docs.microsoft.com/en-us/office/vba/api/excel.querytables.add)を参照のこと。
今回はCSV=テキストファイルなので`Connection`に`Text;`を指定した後にCSVファイルへのパス文字列を追加する。`Destination`には先ほど見つけた書き込み領域を指定する。

次いで`qtCsv`のプロパティを指定していく。ここでは以下のようなCSVを想定している

- 1行目は見出し行
- 文字コードはUTF-8
- カンマ区切り
- 引用符はダブルクォーテーション
- 空データなし

また列幅はテーブル側で指定する方が便利なため、`AdjustColumnWidth`には`false`を指定している。既存データがあった場合の処理は、今回は`RefreshStyle = xlOverwriteCells`として明示的に上書きさせているが、場合によっては修正すべきである。
それ以外のパラメータは「[VBA CSV ファイルの読み込み (QueryTables.Add 関数を使う)](https://www.tipsfound.com/vba/18014)」を参照のこと。

最後に`qtCsv.Delete`で接続を解除するが、その前に`qtCsv.ResultRange`から追加したデータの行数を取得しておく。これを忘れると地味に困るので注意。

#まとめて関数化
```vb:vba
Function AddTableDataFromCsv(table As ListObject, csv_path As String)
    '引数
    '   table : 追加先テーブルのオブジェクト
    '   csv_path : CSVのフルパス Windows形式になっていること。また存在チェックなどは呼び出し側で管理すること
    '文字コードはUTF-8固定 変えたければ任意

    'テーブルが空だったならば、空データを追加してフラグを立てる
    Dim is_empty As Boolean
    If table.ListRows.Count = 0 Then
        table.ListRows.Add
        is_empty = True
    End If

    '''データ書込処理ここから'''
    Dim new_data_range As Range
    Set new_data_range = table.DataBodyRange.Offset(table.ListRows.Count, 0) '既存データ行の一行下を新しいデータ領域として指定
    '※DataBodyRangeは直前で空データを挿入してあるのでNULLにはならない

    'CSVデータを追加
    'クエリテーブルを利用してCSVを取り込む
    '参考 https://tonari-it.com/excel-vba-csv-querytable/

    Dim qtCsv   As QueryTable
    Set qtCsv = table.Parent.QueryTables.Add(
            Connection:="TEXT;" & csv_path, 
            Destination:=new_data_range) '取り込むCSVパスと、セルを指定
    '↑table.ParentがWorksheetオブジェクトを指すことを利用している

    With qtCsv
        .TextFileParseType = xlDelimited   '区切り文字の形式
        .TextFileCommaDelimiter = True 'カンマ区切りの指定
        .TextFileStartRow = 2 '開始行の指定 見出し行を無視するので2行目から
        .TextFileTextQualifier = xlTextQualifierDoubleQuote '引用符の指定
        .TextFilePlatform = 65001 '文字コード指定 Shift-JIS=932, UTF-8=65001
        .AdjustColumnWidth = False '列幅の自動調節をしない
        .RefreshStyle = xlOverwriteCells '既存データがあっても上書き
        .Refresh BackgroundQuery:=False '上記の設定でQueryTablesオブジェクトを更新し、シート上に出力
    End With

    '追加したデータの最終行を取得
    Dim added_rows_count As Long
    added_rows_count = qtCsv.ResultRange.Rows.Count

    'QueryTables.Addメソッドで取り込んだCSVとの接続を解除. 
    qtCsv.Delete 'ここで削除しないとテーブル化できない
    '''データ書込処理ここまで'''

    'リサイズメソッドでテーブルサイズを変更
    table.Resize table.Range.Resize(table.Range.Rows.Count + added_rows_count)  '追加行をテーブル範囲に含める

    If is_empty = True Then      '追加前のテーブルが空だったならば
        table.ListRows(1).Delete 'データの先頭行(空行)を削除
    End If

End Function

```



[^1]: 仕様上は追加しなくても成り立つはずだが、手元の環境では`ListObject.Range.Resize`後の範囲が1行不足する現象が発生した。再現性不明。また、ここで追加しておくことで`ListObject.DataBodyRange`がNULLにならなくなるので事故が減る
[^2]: このとき、テーブルの並べ替えなどを行わないこと