Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。
100本ノックの出題リストはこちらから
excel-ubara.com
出題：表範囲からHTMLのtableタグを作成
#VBA100本ノック 94本目
表をHTMLの「table」に変換するFunctionを作成。
引数(セル範囲,見出行数)でHTMLで返す。
見出行数：>=1は指定行数を「thead」で出力。
セル結合：「td colspan="2" rowspan="2"」等々
空白セル："nbsp;"を出力
※出力サンプルを参考に
※文字位置は不要、インデントは任意
◇ 出題ページはこちら
ソースコード
サンプルファイルはこちら
[準備中]
メインモジュール
Option Explicit ' 100本ノック094：表範囲からHTMLのtableタグを作成 Function セル範囲をhtmlに変換(セル範囲 As Range, 見出し行数 As Long) As String Const ind = " " Dim htmlテキスト As String htmlテキスト = "<table border=""1"">" Dim is見出し行あり As Boolean: is見出し行あり = (見出し行数 > 0) Dim isすべて見出し行 As Boolean: isすべて見出し行 = (見出し行数 = セル範囲.Rows.Count) ' 行のループ Dim R As Long For R = 1 To セル範囲.Rows.Count ' 行の開始タグ If R = 1 And is見出し行あり Then htmlテキスト = htmlテキスト & vbLf & ind & "<thead>" ElseIf R = 見出し行数 + 1 Then htmlテキスト = htmlテキスト & vbLf & ind & "<tbody>" End If Dim is見出し As Boolean is見出し = (R <= 見出し行数) ' 列のループ Dim C As Long For C = 1 To セル範囲.Columns.Count Dim 読取セル As Range Set 読取セル = セル範囲.Cells(R, C) Dim 出力値 As String If 読取セル.Value = "" Then 出力値 = " " Else 出力値 = 読取セル.Value End If ' 結合先頭セル・結合内部セル・単独セルごとに分岐 Select Case True Case Is結合先頭セル(読取セル) htmlテキスト = htmlテキスト & vbLf & ind & ind & ind & span設定HTML(読取セル, is見出し) htmlテキスト = htmlテキスト & vbLf & ind & ind & ind & 出力値 htmlテキスト = htmlテキスト & vbLf & ind & ind & ind & IIf(is見出し, "</th>", "</td>") Case Is結合内部セル(読取セル) ' なにもしない Case Else htmlテキスト = htmlテキスト & vbLf & ind & ind & ind & IIf(is見出し, "<th>", "<td>") htmlテキスト = htmlテキスト & vbLf & ind & ind & ind & 出力値 htmlテキスト = htmlテキスト & vbLf & ind & ind & ind & IIf(is見出し, "</th>", "</td>") End Select Next ' 列のループ ' 行の終了タグ htmlテキスト = htmlテキスト & vbLf & ind & ind & "</tr>" If R = 見出し行数 Then htmlテキスト = htmlテキスト & vbLf & ind & "</thead>" ElseIf R = セル範囲.Rows.Count And (isすべて見出し行 = False) Then htmlテキスト = htmlテキスト & vbLf & ind & "</tbody>" End If Next ' 行のループ htmlテキスト = htmlテキスト & vbLf & "</table>" セル範囲をhtmlに変換 = htmlテキスト End Function ' span設定HTML Function span設定HTML(結合代表セル As Range, is見出し As Boolean) As String Dim 結合行数 As Long: 結合行数 = 結合代表セル.MergeArea.Rows.Count Dim 結合列数 As Long: 結合列数 = 結合代表セル.MergeArea.Columns.Count If is見出し Then Select Case True Case 結合行数 = 1: span設定HTML = "<th colspan=""" & 結合列数 & """>" Case 結合列数 = 1: span設定HTML = "<th rowspan=""" & 結合行数 & """>" Case Else: span設定HTML = "<th rowspan=""" & 結合行数 & """ colspan=""" & 結合列数 & """>" End Select Else Select Case True Case 結合行数 = 1: span設定HTML = "<td colspan=""" & 結合列数 & """>" Case 結合列数 = 1: span設定HTML = "<td rowspan=""" & 結合行数 & """>" Case Else: span設定HTML = "<td rowspan=""" & 結合行数 & """ colspan=""" & 結合列数 & """>" End Select End If End Function
汎用関数
' 結合セル判定 Function Is結合先頭セル(判定セル As Range) As Boolean Is結合先頭セル = (判定セル.MergeCells And 判定セル.Address = 判定セル.MergeArea.Cells(1, 1).Address) End Function Function Is結合内部セル(判定セル As Range) As Boolean Is結合内部セル = (判定セル.MergeCells And 判定セル.Address <> 判定セル.MergeArea.Cells(1, 1).Address) End Function Function Is結合セル全体(判定エリア As Range) As Boolean Is結合セル全体 = (判定エリア.MergeCells And 判定エリア.Address = 判定エリア.Cells(1, 1).MergeArea.Address) End Function ' 改行文字の置き換え Function 文中改行を指定文字に置き換える(元テキスト As String, Optional 置換テキスト As String = " ") As String Dim 結果テキスト As String 結果テキスト = Replace(元テキスト, vbCrLf, 置換テキスト) 結果テキスト = Replace(結果テキスト, vbCr, 置換テキスト) 結果テキスト = Replace(結果テキスト, vbLf, 置換テキスト) 文中改行を指定文字に置き換える = 結果テキスト End Function
解説
とくにひねりなく、愚直にHTMLタグを挿入していくコードです。
外側の行ループ時に＜tbody＞＜thead＞を前後に挿入し、
内側の列ループ時に各データに＜td＞＜th＞を前後に挿入しています。
セル結合の対応は、
- 結合先頭セルであればspanタグを入れる
- 結合内部セルであればなにもしない
- 単独セルであれば通常のタグを入れる
という分岐になるためそんなに複雑なロジックにはなりませんでした。
問題は見出しとデータの判定の方で、
すべてがデータ、すべてが見出しという表もあり得ることを考慮すると、
どこの分岐で、どんな判定で組むがかなり分かれるポイントです。
今回は
- 行ループの開始直後に＜tbody＞＜thead＞
- 行ループの終了直前に＜/tbody＞＜/thead＞
に統一するため、
' 行の開始タグ If R = 1 And is見出し行あり Then htmlテキスト = htmlテキスト & vbLf & ind & "<thead>" ElseIf R = 見出し行数 + 1 Then htmlテキスト = htmlテキスト & vbLf & ind & "<tbody>" End If
このようなIf～Else文で表現をしました。
＜thead＞は最初の出力のためループの外でやるのも手なのですが、
＜tbody＞＜thead＞の出力箇所を揃えるためにこうしています。
このロジックを綺麗に書くために、コード冒頭で
Dim is見出し行あり As Boolean: is見出し行あり = (見出し行数 > 0) Dim isすべて見出し行 As Boolean: isすべて見出し行 = (見出し行数 = セル範囲.Rows.Count)
この説明変数を用意しています。
これによりIf ～ And文が綺麗にかけていますので参考にしてみてください。
