【Excel VBA】 マクロで自動で表を作成する方法（ヘッダーとなる範囲を選択して表を作成）

#1.この記事について
こんなケースを想定。
《ヘッダー（見出し行）とデータのみを書き込んだ状態から、表のレイアウトを作成したい。》
《ついでに一番左の列に自動で連番を記入したい。》

#2.やりたいこと
↓ここまでデータが記入されている状態から、
![キャプチャ.PNG](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/294ffe80-0493-e5d4-f532-69a337fcbbf7.png)
ヘッダー（見出し行）を範囲選択して、
![コメント 2019-12-01 015844.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/058d64dd-30b3-2d56-da93-131079c96085.png)
このようにレイアウトを自動作成したい。
![コメント 2019-12-01 020032.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/8c312885-b974-e866-9e1b-60d662d4088a.png)
さらに、
この状態から、
![コメント 2019-12-01 015844.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/25ea7011-191e-6658-742a-73f3f95c5907.png)
こんな感じでID列に自動採番したい。
![コメント 2019-12-01 020120.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/4bd80e65-b4c3-a7b5-a54f-ce430e4a1496.png)

__レイアウト作成観点__

1.ヘッダー行の背景色を変更して強調表示。
2.ヘッダー行を中央揃えにする。
3.表に罫線を引く。

#3.作成したコード
①連番しない方

```vb:Module_TableCreate.bas
'******************************************************************************************
'*関数名    ：createTableForSelectedHeader
'*機能      ：選択した範囲をヘッダーとして表を作成。
'*使用法    ：表のヘッダーとなるセルを範囲選択した状態でプログラム実行。
'*引数(1)   ：なし
'******************************************************************************************
Public Sub createTableForSelectedHeader()
    
    '定数
    Const FUNC_NAME As String = "createTableForSelectedHeader"
    
    '変数
    Dim headerLeftColumnNum As Long     'ヘッダーの最左端の列番号
    Dim headerNum As Long               'ヘッダー項目数を格納
    Dim headersRowNum As Long           'ヘッダーの存在する行番号を格納
    Dim tableLastRowNum As Long         '表の一番下の行番号
    Dim cnt As Long                     'ループカウンタ
    Dim cnt2 As Long                    'ループカウンタ
    Dim tempLong As Long                '一時的に格納する変数
    
    On Error GoTo ErrorHandler
    '以下に処理を記述
    
    '値の初期化
    tableLastRowNum = 0
    
    'ヘッダーの情報を取得
    '最左端の列番号、項目数、行番号
    headerLeftColumnNum = Selection(1).Column
    headerNum = Selection(Selection.Count).Column - headerLeftColumnNum + 1
    headersRowNum = Selection(Selection.Count).Row
    
    'ヘッダーセルの列のそれぞれについて、データのある最終行番号を取得
    'そのうちで最も大きな行番号を表の一番下とする
    For cnt = headerLeftColumnNum To (headerLeftColumnNum + headerNum - 1)
    
        '最終行番号取得
        tempLong = ActiveSheet.Cells(Rows.Count, cnt).End(xlUp).Row
        
        '空欄を無視（数式で空欄になっている箇所は、データとみなさない）
        For cnt2 = tempLong To 1 Step -1
            '空欄でないセルが見つかったなら、空欄を無視した最終行番号をtempに格納してループ終了
            If ActiveSheet.Cells(cnt2, cnt) <> "" Then
                tempLong = cnt2
                Exit For
            End If
        Next cnt2
                        
        '上記tempを、
        '最も大きな行番号を格納している変数（tableLastRowNum）と比べ、
        'それより大きければtableLastRowNumを更新
        If tableLastRowNum < tempLong Then
            tableLastRowNum = tempLong
        End If
        
    Next cnt
    
    'ヘッダーの色を変更し、中央揃えにする
    With Selection
        .Interior.ColorIndex = 28
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
    End With
    
    '表に罫線を引く
    Range(Selection(1), _
          ActiveSheet.Cells(tableLastRowNum, headerLeftColumnNum + headerNum - 1) _
          ).Borders.LineStyle = xlContinuous
    

ExitHandler:

    Exit Sub
    
ErrorHandler:

        MsgBox "エラーが発生しましたので終了します" & _
                vbLf & _
                "関数名：" & FUNC_NAME & _
                vbLf & _
                "エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
        
        GoTo ExitHandler
        
End Sub



```

②連番する方

```vb:Module_TableCreate.bas
'******************************************************************************************
'*関数名    ：createTableForSelectedHeader_availableNumbering
'*機能      ：選択した範囲をヘッダーとして表を作成。最左端列に自動で連番で採番する機能あり。
'*使用法    ：表のヘッダーとなるセルを範囲選択した状態でプログラム実行。
'*引数(1)   ：なし
'******************************************************************************************
Public Sub createTableForSelectedHeader_availableNumbering()
    
    '定数
    Const FUNC_NAME As String = "createTableForSelectedHeader_availableNumbering"
    
    '変数
    Dim headerLeftColumnNum As Long     'ヘッダーの最左端の列番号
    Dim headerNum As Long               'ヘッダー項目数を格納
    Dim headersRowNum As Long           'ヘッダーの存在する行番号を格納
    Dim tableLastRowNum As Long         '表の一番下の行番号
    Dim cnt As Long                     'ループカウンタ
    Dim cnt2 As Long                    'ループカウンタ
    Dim tempLong As Long                '一時的に格納する変数
    Dim incrementLong As Long           '採番用変数
    
    On Error GoTo ErrorHandler
    '以下に処理を記述
    
    '値の初期化
    tableLastRowNum = 0
    
    'ヘッダーの情報を取得
    '最左端の列番号、項目数、行番号
    headerLeftColumnNum = Selection(1).Column
    headerNum = Selection(Selection.Count).Column - headerLeftColumnNum + 1
    headersRowNum = Selection(Selection.Count).Row
    
    'ヘッダーセルの列のそれぞれについて、データのある最終行番号を取得
    'そのうちで最も大きな行番号を表の一番下とする
    For cnt = headerLeftColumnNum To (headerLeftColumnNum + headerNum - 1)
    
        '最終行番号取得
        tempLong = ActiveSheet.Cells(Rows.Count, cnt).End(xlUp).Row
        
        '空欄を無視（数式で空欄になっている箇所は、データとみなさない）
        For cnt2 = tempLong To 1 Step -1
            '空欄でないセルが見つかったなら、空欄を無視した最終行番号をtempに格納してループ終了
            If ActiveSheet.Cells(cnt2, cnt) <> "" Then
                tempLong = cnt2
                Exit For
            End If
        Next cnt2
                        
        '上記tempを、
        '最も大きな行番号を格納している変数（tableLastRowNum）と比べ、
        'それより大きければtableLastRowNumを更新
        If tableLastRowNum < tempLong Then
            tableLastRowNum = tempLong
        End If
        
    Next cnt
    
    'ヘッダーの色を変更し、中央揃えにする
    With Selection
        .Interior.ColorIndex = 28
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
    End With
    
    '表に罫線を引く
    Range(Selection(1), _
          ActiveSheet.Cells(tableLastRowNum, headerLeftColumnNum + headerNum - 1) _
          ).Borders.LineStyle = xlContinuous
    
    '最左端列に連番で採番する
    incrementLong = 1
    For cnt = (headersRowNum + 1) To tableLastRowNum
        ActiveSheet.Cells(cnt, headerLeftColumnNum).Value = incrementLong
        incrementLong = incrementLong + 1
    Next
    

ExitHandler:

    Exit Sub
    
ErrorHandler:

        MsgBox "エラーが発生しましたので終了します" & _
                vbLf & _
                "関数名：" & FUNC_NAME & _
                vbLf & _
                "エラー番号" & Err.Number & Chr(13) & Err.Description, vbCritical
        
        GoTo ExitHandler
        
End Sub


```

#4.コードの解説

__・ヘッダーの情報を取得__

やや回りくどい方法をとりました。
通常ならこうするのだろうけど↓

```vb
    headerLeftColumnNum = Selection(1).Column
    headerNum = Selection.Count
    headersRowNum = Selection(1).Row
```

この場合、このように結合したセルがヘッダーだった場合に対応できない欠点がありました。
![コメント 2019-12-01 022338.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/541790/11f93c1a-ebbb-8aca-7715-84f46f2ae3f2.png)

そのため、上に記したようにしてあります。


__・[For cnt = headerLeftColumnNum To (headerLeftColumnNum + headerNum - 1)]のループの意味__

ヘッダーとして選んだ列の一つ一つについて、データがどのくらいの深さがあるか探索しています。
例えば
B列の一番下のデータの行番号が10、
C列のそれが14、
D列のそれが12ならば、
C列の「14」を表が持つ一番下のデータの行番号と認識します。


__・空欄を無視（数式で空欄になっている箇所は、データとみなさない）__

数式の結果空欄になるパターンを無視できます。


#5.終わりに
なにか補足がありましたらコメントください。