1.この記事について
こんなケースを想定。
《ヘッダー（見出し行）とデータのみを書き込んだ状態から、表のレイアウトを作成したい。》
《ついでに一番左の列に自動で連番を記入したい。》
2.やりたいこと
↓ここまでデータが記入されている状態から、
ヘッダー（見出し行）を範囲選択して、
このようにレイアウトを自動作成したい。
さらに、
この状態から、
こんな感じでID列に自動採番したい。
レイアウト作成観点
1.ヘッダー行の背景色を変更して強調表示。
2.ヘッダー行を中央揃えにする。
3.表に罫線を引く。
3.作成したコード
①連番しない方
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
②連番する方
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.コードの解説
・ヘッダーの情報を取得
やや回りくどい方法をとりました。
通常ならこうするのだろうけど↓
headerLeftColumnNum = Selection(1).Column
headerNum = Selection.Count
headersRowNum = Selection(1).Row
この場合、このように結合したセルがヘッダーだった場合に対応できない欠点がありました。
そのため、上に記したようにしてあります。
・[For cnt = headerLeftColumnNum To (headerLeftColumnNum + headerNum - 1)]のループの意味
ヘッダーとして選んだ列の一つ一つについて、データがどのくらいの深さがあるか探索しています。
例えば
B列の一番下のデータの行番号が10、
C列のそれが14、
D列のそれが12ならば、
C列の「14」を表が持つ一番下のデータの行番号と認識します。
・空欄を無視（数式で空欄になっている箇所は、データとみなさない）
数式の結果空欄になるパターンを無視できます。
5.終わりに
なにか補足がありましたらコメントください。