Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。
100本ノックの出題リストはこちらから
excel-ubara.com
出題:全テーブル一覧作成
#VBA100本ノック 44本目
ブック内の全シート全テーブルについて、以下の情報をシートに出力してください。
・A列にテーブル名(テーブル1)
・B列にシート名(Sheet1)
・C列にセル範囲($B$2:$F$12)
・D列にリスト行数(10)
・E列にリスト列数(5)
※()内は画像の出力例
※対象ブック及び出力シートは任意

◇ 出題ページはこちら
ソースコード
Option Explicit ' 100本ノック044:全テーブル一覧作成 ' テーブル一覧レイアウト (※1リテラルあり) Private Const ShNameテーブル一覧 = "テーブル一覧" Private Const R1stテーブル一覧 = 2 Private Enum CNoテーブル一覧 テーブル名 = 1 シート名 セル範囲 リスト行数 リスト列数 End Enum ' メインプロシージャ Function 指定ブック内の全テーブルをリストアップしたシートを出力する(wb対象ブック As Workbook) As Worksheet ' リストを新規ブックのシートとして出力 Dim ws出力 As Worksheet Set ws出力 = Workbooks.Add.Worksheets(1) Set 指定ブック内の全テーブルをリストアップしたシートを出力する = ws出力 ' レイアウト設定 (※1) ws出力.Name = "テーブル一覧" ws出力.Range("A1:E1").Value = Split("テーブル名,シート名,セル範囲,リスト行数,リスト列数", ",") ws出力.Columns("A:E").HorizontalAlignment = xlCenter ' 全シートの全ListObjectをループ Dim R_出力 As Long: R_出力 = R1stテーブル一覧 Dim シート As Worksheet For Each シート In wb対象ブック.Worksheets Dim テーブル As ListObject For Each テーブル In シート.ListObjects ' 各情報をセルに出力 ws出力.Cells(R_出力, CNoテーブル一覧.テーブル名) = テーブル.Name ws出力.Cells(R_出力, CNoテーブル一覧.シート名) = シート.Name ws出力.Cells(R_出力, CNoテーブル一覧.セル範囲) = テーブル.Range.Address(0, 0) ws出力.Cells(R_出力, CNoテーブル一覧.リスト行数) = テーブル.ListRows.Count ws出力.Cells(R_出力, CNoテーブル一覧.リスト列数) = テーブル.ListColumns.Count R_出力 = R_出力 + 1 Next Next ' 列幅自動調整 ws出力.Columns("A:B").AutoFit End Function ' テストプロシージャ Sub 実行テスト() 指定ブック内の全テーブルをリストアップしたシートを出力する(ThisWorkbook).Parent.Saved = True End Sub
解説
テーブルの情報を取得する問題です。
テーブルはListObjectsコレクションの中に入っており、
ListObjectsコレクションはWorksheetオブジェクトの中にいます。
よって、
Dim シート As Worksheet For Each シート In wb対象ブック.Worksheets Dim テーブル As ListObject For Each テーブル In シート.ListObjects
このFor Eachを組むことが肝となる問題ですね。
あとは「テーブル.」で表示される候補を眺めながら、
どのプロパティから目的の情報を得られるか試していけば完成します。
テーブルに関する解説はこのくらいですが、他枝葉の解説として、
今回はEnumを同じモジュール内にPrivateで書きました。
今回のマクロは汎用マクロっぽい処理で単独実行が多そうだったので、
いつものような定義モジュールの準備はしない方がよさそうという判断です。
また定数に関する話として、
ws出力.Range("A1:E1").Value = Split("テーブル名,シート名,セル範囲,リスト行数,リスト列数", ",") ws出力.Columns("A:E").HorizontalAlignment = xlCenter
このあたりも頑張ればマジックナンバー(ストリング)を無くすことはできます。
が、定数化の目的はあくまで「定義部分だけ見れば改修ポイントがわかる」ことです。
わざわざこの辺を&でつなげまくった面倒なコードにしなくても、
' テーブル一覧レイアウト (※1リテラルあり)
このコメントで十分機能すると思います。
この手法も活用してください。
最後に小ネタですが、今回新規ブックにシートを出力していると、
テスト中に閉じる際の保存確認ウィンドウがうっとおしくなります。
その対策として、
' テストプロシージャ Sub 実行テスト() 指定ブック内の全テーブルをリストアップしたシートを出力する(ThisWorkbook).Parent.Saved = True End Sub
このように「Saved = True」として保存済み(未編集)に変更することが可能です。
この設定は未保存のブック(Book1のままの状態)でも可能ですので、
テストの手法として覚えておいてください。
くれぐれも「ThisWorkbook.Saved = True」とならないようにだけ気を付けて、
積極的に活用していきましょう。