上級者を目指すExcelVBA #9『テーブルを使う』

Excelでは以下のように表を作ってデータを入力するというケースが多いと思います。

<img src = "https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/0f44bde5-9062-a523-7a14-a73b8abbc797.png" width = "584" />

この表の最終行の下に1行追加しようとする場合、最終行をコピペして行を増やすという処理になると思います。
これをマクロでやるのはなかなか面倒くさい。

こういった表を扱う場合、テーブル（ListObject）を使うと圧倒的に便利です。

　
### テーブルの作成方法

テーブルを作成するには、範囲を選択してExcelの上部メニューの「挿入」タブ→「テーブル」→「先頭行をテーブルの見出しとして使用」にチェックを入れてOKを押します。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/0fded9be-bd97-966d-07f5-8827fa46957b.png)


勝手に表の配色が変わるので、これが嫌な場合は「デザイン」タブ → 「テーブルスタイル」からスタイルなしのものを選ぶと元に戻ります。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/b5831158-11da-dc37-9663-0a9085ff7eb7.png)

また、テーブルに名前を付けたい場合は「デザイン」タブ → 「テーブル名」から変更します。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/5954115d-eb27-7227-987b-185a471a63f7.png)

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/2a47df18-2283-72d4-b4b7-a1d3d80a3027.png)

表の右下にマークが付くとテーブル作成完了となります。
　


### テーブルへの行の追加

作成したテーブルに手入力で行を追加しましょう。
最終行の下の行に何か入力するだけでOKです。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/4edcd3ee-76a2-95a8-c07b-969047f0cc3a.png)

自動的にテーブルの行が追加され、書式や計算式も引き継がれています。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/b9782c4e-57ba-950a-69db-129b1a71559c.png)


### VBAでテーブルからデータ読込

今度はVBAでテーブルを扱ってみましょう。

テーブルからデータを読み込む場合、まずはシート上のListObjectsから ListObjects("テーブル名") のような形でテーブルを取得します。

シート上にテーブルが1件しかない場合は ListObjects(1) でも構いません。

```vba:GradeListSheet    
    ' テーブルをセット
    Set TLo = GradeListSheet.ListObjects(TARGET_TABLE_NAME)
```
　

データを１行ずつ読み込みたい場合、以下のように走査します。
列番号は定数で定義しています。
テーブルを使わない場合に比べると非常に簡単ですね。

```vba:GradeListSheet
    ' 行を走査
    For i = 1 To TLo.DataBodyRange.Rows.count
        ' 氏名、合計を読込
        uName = TLo.DataBodyRange(i, NAME_CLM)
        sumScore = TLo.DataBodyRange(i, SUM_CLM)
        
        ' 出力
        Debug.Print uName, sumScore
    Next
```

コードの全体像は以下のようになります。

```vba:GradeListSheet
' モジュール名
Const MODULE_NAME = "GradeListSheet"

' テーブル名
Const TARGET_TABLE_NAME = "成績表"

' テーブル内列番号　名前
Const NAME_CLM = 1

' テーブル内列番号　国語
Const NL_CLM = 2

' テーブル内列番号　数学
Const MATH_CLM = 3

' テーブル内列番号　英語
Const ENG_CLM = 4

' テーブル内列番号　合計
Const SUM_CLM = 5

' テーブル
Private TLo As ListObject


'============================================================
'
' 1. テーブルからデータ読込
'
'============================================================
 
' テーブルからデータ読込
' 　・テーブルから各ユーザの合計点を読み込んで出力
'
Public Sub readDataFromLO()
    On Error GoTo ErrHdl
    Dim i, uName, sumScore
    ' テーブルをセット
    Set TLo = GradeListSheet.ListObjects(TARGET_TABLE_NAME)
    
    ' 行を走査
    For i = 1 To TLo.DataBodyRange.Rows.count
        ' 氏名、合計を読込
        uName = TLo.DataBodyRange(i, NAME_CLM)
        sumScore = TLo.DataBodyRange(i, SUM_CLM)
        
        ' 出力
        Debug.Print uName, sumScore
    Next
ErrHdl:
    If Err.Number <> 0 Then
        Debug.Print MODULE_NAME & ".readDataFromLO", Err.Description
    End If
End Sub

```
　
　
### VBAでテーブルへデータ入力

今度はテーブルにデータを入力してみます。
テーブルの新しい行にデータを入力したい場合、最終行の下の行に入力するだけです。
非常に簡単ですね。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/ee9e1dd0-1f29-6a91-cf9c-48c6341c4c46.png)

```vba:GradeListSheet
' テーブルにデータを入力
'　・最終行の下に「テスト」ユーザのデータ入力
'
Public Sub writeNewDataToTable()
    On Error GoTo ErrHdl
    Dim i

    ' テーブルをセット
    Set TLo = GradeListSheet.ListObjects(1)
    
    With TLo
        ' 最終行 + 1の行番号をセット
        i = .DataBodyRange.Rows.count + 1
        
        ' 最終行の下にデータ入力
        .DataBodyRange(i, NAME_CLM) = "テスト"
        .DataBodyRange(i, NL_CLM) = 30
        .DataBodyRange(i, MATH_CLM) = 20
        .DataBodyRange(i, ENG_CLM) = 100
    End With
ErrHdl:
    If Err.Number <> 0 Then
        Debug.Print MODULE_NAME & ".writeNewDataToTable", Err.Description
    End If
End Sub
```
　

### テーブル全体にデータを高速に入力

上記では1行ずつテーブルに書き込んでいますが、大量のデータが有る場合はかなり時間がかかります。
そういった場合は配列にデータを入れてそれをまとめてテーブルに描画すると高速に処理ができます。

以下のようにテーブルに配列からデータを書き込む関数を作っておくと良いでしょう。

```vba:Util

' テーブルに配列の値を書き込む。テーブルのサイズは配列の値にあわせて自動で変更
'
' 引数： sh                  Worksheet      書き込み対象シート
'        lo                  ListObject　   書き込み対象テーブル
'        vals                Variant 　　   二次元配列
'        fClm                Long    　　   描画を始める開始列
'        clearLoUnderFormats Boolean        テーブルの下の書式、罫線を削除
'
Public Sub writeValsToLO(ByRef sh As Worksheet, ByRef lo As ListObject, ByRef vals As Variant, Optional ByVal clearLoUnderFormats As Boolean = True)
    On Error GoTo ErrHdl
    Dim fRow, fClm, eRow, eClm
            
    With lo
        fRow = .Range.row
        fClm = .Range.Column
        eRow = .Range.row + UBound(vals)
        eClm = fClm + .Range.Columns.count - 1
        
        ' リストオブジェクトのサイズ変更
        .Resize sh.Range(sh.cells(fRow, fClm), sh.cells(eRow, eClm))
        ' 値のクリア
        sh.Range(sh.cells(fRow + 1, fClm), sh.cells(eRow, eClm)).cells.Value = ""
    
        ' 下部の書式、罫線、値のクリア
        If clearLoUnderFormats Then
            sh.Range(sh.cells(eRow + 1, fClm), sh.cells(eRow + 1000, eClm)).cells.ClearFormats
            ' 罫線削除
            sh.Range(sh.cells(eRow + 1, fClm), sh.cells(eRow + 1000, eClm)).Borders.LineStyle = xlNone
            ' 値のクリア
            sh.Range(sh.cells(eRow + 1, fClm), sh.cells(eRow + 1000, eClm)).cells.Value = ""
        End If
        
        ' 書き込み
        Call Util.writeArrayValsToCells(sh, vals, .Range.row + 1, .Range.Column)
    End With
ErrHdl:
    If Err.Number <> 0 Then
        Debug.Print MODULE_NAME & ".writeValsToLO", Err.Description
    End If
End Sub

' 大量のデータを配列から対象セルへ瞬時に書き込む
'
' 引数： sh    Worksheet　 書き込み対象シート
'        Vals  Variant　　二次元配列
'        fRow  Long       対象範囲の開始行
'        fClm  Long       対象範囲の開始列
'
Public Sub writeArrayValsToCells(ByRef sh As Worksheet, vals As Variant, fRow, fClm)
    On Error GoTo ErrHdl
    Dim rowSize, clmSize, datas, r, eRow, eClm
    
    ' 行の数、列の数をセット
    rowSize = UBound(vals, 1)
    clmSize = UBound(vals, 2)    
    eRow = fRow + rowSize - 1
    eClm = fClm + clmSize - 1
    
    ' 範囲をセット
    Set r = sh.Range(sh.cells(fRow, fClm), sh.cells(eRow, eClm))    
    ' データを書き込み
    r.Value = vals
ErrHdl:
    If Err.Number <> 0 Then
        Debug.Print MODULE_NAME & ".writeArrayValsToCells " & sh.name, Err.Description
    End If
End Sub
```
　

続けて、以下のように二次元配列を再定義し、値をセットした上で上記関数を呼び出してやります。

```vba:GradeListSheet
' 大量のデータをまとめてテーブルに入力
'　・2000件分のデータをテーブルにまとめて入力
'
Public Sub writeAllDataToTable()
    On Error GoTo ErrHdl
    Dim vals, i
    Const DRAW_ROW_COUNT = 2000
    
    ' テーブルをセット
    Set TLo = GradeListSheet.ListObjects(1)    
    ' 二次元配列再定義
    ReDim vals(1 To DRAW_ROW_COUNT, 1 To TLo.Range.Columns.count)
    
    ' 配列にデータ格納
    For i = 1 To DRAW_ROW_COUNT
        vals(i, NAME_CLM) = "テスト"
        vals(i, NL_CLM) = i
        vals(i, MATH_CLM) = i
        vals(i, ENG_CLM) = i
        vals(i, SUM_CLM) = i * 3
    Next
    
    ' テーブルにデータをまとめて描画
    Call Util.writeValsToLO(GradeListSheet, TLo, vals)
ErrHdl:
    If Err.Number <> 0 Then
        Debug.Print MODULE_NAME & ".writeAllDataToTable", Err.Description
    End If
End Sub

```

数千件のデータでも一瞬で描画できます。
楽で良いですね。

<img src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/200881/62ff6bae-8a6b-bc60-0ea8-b0f388b53783.png" width = "400" />