VBA100本ノック 44本目：全テーブル一覧作成

この記事から得るもの

１つのBook内にあるすべてのテーブル情報を取得する。

１　今回のお題

ブック内の全シート全テーブルについて、以下の情報をシートに出力してください。
・A列にテーブル名(テーブル1)
・B列にシート名(Sheet1)
・C列にセル範囲($B$2:$F$12)
・D列にリスト行数(10)
・E列にリスト列数(5)
※()内は画像の出力例
※対象ブック及び出力シートは任意

f:id:bimori466:20210108222323p:plain

excel-ubara.com

２　今回のお題の意図

お題を読んだだけでは意図が分からなかったので補足動画GIFをつけました↓↓

ノック４４本目：処理イメージ pic.twitter.com/vXpaGFf3tn
— かずやん_VBAerLv.５ (@y8bV4ty1wbkTjPd) 2021年1月8日

動画の例で言うと、Sheet1～Sheet３の中にテーブルが計４つあります。そのテーブルの情報（テーブル名、シート名、セル範囲、行数、列数）を取得することが今回のお題の意図になっています。

３　回答

ListObjectを初めて知ったので、順を追って解説していきます。

まずは、Sheetにテーブルが存在するかどうかを判断しなければなりません。判断するためのコードが以下のコード↓↓

Sub テーブルが存在するか判定する_アクティブシート()

    Dim listObjectCount As Integer
    Dim DB1 As ListObject
    
    listObjectCount = ActiveSheet.ListObjects.Count
    
    If ActiveSheet.ListObjects.Count = 0 Then
      MsgBox "テーブルは存在しません。"
    Else
      MsgBox "テーブルが存在します。"
    End If
        
    
    For Each DB1 In ActiveSheet.ListObjects
        Debug.Print DB1.Name
    Next

End Sub

処理結果

f:id:bimori466:20210109065554p:plain

これはSheet３をActiveにした時の処理結果です。テーブルが２つあるので、イミディエイトウィンドウに２つのテーブル名を返します。
重要な点は、「 ActiveSheet.ListObjects.Count」で、SheetにあるListObjectsの数を数えられるという点です。
つまり、このお題をクリアするためにはすべてのSheetをループして、ListObjectsの数だけループすればよいということです。

私の最終回答

Option Explicit

Sub ノック44本目_2()

    '変数宣言--------------------------------------------------------
    Dim sh As Worksheet
    Dim listObjectCount As Integer
    Dim i As Integer
    Dim tableName As String
    Dim tableSheetName As String
    Dim tableRange As String
    Dim tableRowCount As Long
    Dim tableColumnCount As Long
    Dim ws As Worksheet: Set ws = Worksheets("テーブル一覧")
    Dim write_IX As Long: write_IX = ws.Cells(Rows.Count, 1).End(xlUp).Row
    '________________________________________________________________
    
    For Each sh In Sheets
        listObjectCount = sh.ListObjects.Count
            
        For i = 1 To listObjectCount
            tableName = sh.ListObjects(i).Name
            tableSheetName = sh.Name
            tableRange = sh.ListObjects(i).Range.Cells.Address
            tableRowCount = sh.ListObjects(i).Range.Rows.Count
            tableColumnCount = sh.ListObjects(i).Range.Columns.Count
            
            '書込み処理
            write_IX = write_IX + 1
            
            ws.Cells(write_IX, 1) = tableName
            ws.Cells(write_IX, 2) = tableSheetName
            ws.Cells(write_IX, 3) = tableRange
            ws.Cells(write_IX, 4) = tableRowCount
            ws.Cells(write_IX, 5) = tableColumnCount
            
        Next
    Next

End Sub