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

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

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

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

　

テーブルの作成方法

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

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

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

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

テーブルへの行の追加

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

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

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

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

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

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

GradeListSheet

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

　

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

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

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

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でテーブルへデータ入力

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

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

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

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

　

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

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

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