はじめに
2008年くらいにWindows版Excelで作成したVBAマクロを見つけたので、Mac版Excelでも動くのか試してみたのですが、大抵動く、という結果でした。
せっかくなので、VBAマクロを切り出して残しておこうと思います。
VBAマクロ
概要
以下のようなデータと範囲選択を行なった状態で 表ネスト形式化() を実行すると、、、
以下のように、所定の位置に行が挿入され、ネスト的な表に変更されます。
図では選択範囲がAとBの２列ですが、それ以上の列でも同じ判定条件で処理を行います。
処理の内容として、単純に処理対象行の上に行を挿入して、選択範囲の１列目を、挿入した行に切り取り・貼り付けしているだけです。行の挿入はワークシート全体に対し行なっているため、Cの列や表の外の0〜5の数字の列も追随します。
また、それなりの罫線を引くVBAマクロもあります。選択範囲の１列目の未入力のセルに横罫線を引かない、といった内容です。（実行結果の図は割愛）
ソース
Option Explicit
'=====================================================================
'共通
'=====================================================================
'---------------------------------------------------------------------
'選択エリア情報格納用
'---------------------------------------------------------------------
Public Type SelectionInfo
StartRowIndex As Long '選択エリアの一番上の行インデックス
StartColIndex As Long '選択エリアの一番左の列インデックス
EndRowIndex As Long '選択エリアの一番下の行インデックス
EndColIndex As Long '選択エリアの一番右の列インデックス
RowCount As Long '選択エリア内の行数
ColCount As Long '選択エリア内の列数
CurrentRowIndex As Long '現在の行インデックス
CurrentColIndex As Long '現在の列インデックス
End Type
'---------------------------------------------------------------------
'選択エリア情報格納処理
'---------------------------------------------------------------------
'シートの内容を加工するのに必要となる「選択エリア」の情報を格納して返します。
Public Function GetSelectionInfo() As SelectionInfo
Dim selInf As SelectionInfo
With selInf
.StartRowIndex = Selection.Row
.StartColIndex = Selection.Column
.EndRowIndex = Selection.Rows.Count + Selection.Row
.EndColIndex = Selection.Columns.Count + Selection.Column
.RowCount = Selection.Rows.Count
.ColCount = Selection.Columns.Count
.CurrentRowIndex = ActiveCell.Row
.CurrentColIndex = ActiveCell.Column
End With
GetSelectionInfo = selInf
End Function
'
' 機能一覧
'
' マクロ名 概要
' ------------------------ ------------------------------------------------------
' 表ネスト形式化 連続データをネスト形式に加工します。
' ネスト表罫線作成 ネストされた表の罫線を引きます。
' ネスト表罫線作成_細点線版 ネスト表罫線作成の細点線版です。
'=====================================================================
'選択エリアの通常表をネスト表に加工
'=====================================================================
Public Sub 表ネスト形式化()
NormalTbl2NestTbl
End Sub
Private Sub NormalTbl2NestTbl()
'選択されている連続データをネスト形式に加工する
'基データは
'AAA BBB CCC DDD
' EEE FFF
' GGG HHH III
'であること。上記は、
'AAA
' BBB
' CCC
' DDD
' EEE
' FFF
'(以降省略)
'となる。
'実行後、選択エリアだけでなくシート全体の行が追加される
Dim colIdx As Long
Dim rowIdx As Long
Dim selInf As SelectionInfo 'シートの選択領域
Dim lngAddCnt As Long '追加行数
lngAddCnt = 0
'選択情報取得
selInf = GetSelectionInfo()
'最後のセルから逆順に処理を行なう
'Rowループ
For rowIdx = (selInf.EndRowIndex - 1) To selInf.StartRowIndex Step -1
'Colループ
For colIdx = (selInf.EndColIndex - 1) To (selInf.StartColIndex + 1) Step -1
'ネスト表形成
If Cells(rowIdx, colIdx) <> "" Then
'値がセットされている場合にのみ処理
If Cells(rowIdx, colIdx - 1) <> "" Then
'左のセルに値がセットされている場合にのみ処理
'現在の行に1行追加
Rows(CStr(rowIdx) & ":" & CStr(rowIdx)).Insert Shift:=xlDown
'追加した行に、処理対象のセルよりも左のセルをカット＆ペーストする
Range(Cells(rowIdx + 1, selInf.StartColIndex), _
Cells(rowIdx + 1, colIdx - 1)).Cut _
Destination:=Cells(rowIdx, selInf.StartColIndex)
'追加した行数を加算
lngAddCnt = lngAddCnt + 1
End If
End If
Next
Next
'選択エリア修正(加算した行数分拡大する)
Range(Cells(selInf.StartRowIndex, selInf.StartColIndex), _
Cells(selInf.EndRowIndex + lngAddCnt - 1, selInf.EndColIndex - 1)).Select
End Sub
'=====================================================================
'選択エリアのネスト表に罫線を引く
'=====================================================================
Public Sub ネスト表罫線作成()
DrawNestLines (xlThin)
End Sub
Public Sub ネスト表罫線作成_細点線版()
DrawNestLines (xlHairline)
End Sub
Private Sub DrawNestLines(xlMyPtn As Long)
'ネストされている表の罫線を引く
'範囲指定後実行すること
Dim colIdx As Long
Dim rowIdx As Long
Dim selInf As SelectionInfo 'シートの選択領域
'選択情報取得
selInf = GetSelectionInfo()
'大枠作成・中罫線消去
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
Selection.Borders(xlEdgeLeft).Weight = xlMyPtn
Selection.Borders(xlEdgeTop).Weight = xlMyPtn
Selection.Borders(xlEdgeBottom).Weight = xlMyPtn
Selection.Borders(xlEdgeRight).Weight = xlMyPtn
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'Rowループ
For rowIdx = selInf.StartRowIndex To selInf.EndRowIndex - 1
'Colループ
For colIdx = selInf.StartColIndex To selInf.EndRowIndex - 1
'罫線引き
Cells(rowIdx, colIdx).Borders(xlEdgeLeft).LineStyle = xlContinuous
Cells(rowIdx, colIdx).Borders(xlEdgeLeft).Weight = xlMyPtn
If Cells(rowIdx, colIdx) <> "" Then
Range(Cells(rowIdx, colIdx), Cells(rowIdx, selInf.EndColIndex - 1) _
).Borders(xlEdgeTop).LineStyle = xlContinuous
Range(Cells(rowIdx, colIdx), Cells(rowIdx, selInf.EndColIndex - 1) _
).Borders(xlEdgeTop).Weight = xlMyPtn
Exit For
End If
Next
Next
End Sub
補足
共通部について
本当は、共通に記述されているPublicな定義は、別のモジュールに定義されていました。Publicのままにしていますが、特別な意味はないので必要に応じてPrivateにして良いです。
所感
「ネスト的な表」という表現で伝わるかどうか微妙です。
当時、機能一覧やタスク一覧を羅列した後に、前述の図のような見出し行を作成して一覧表を作ることが多かったため、このようなVBAマクロを作成していました。
要するに、表をカテゴライズしつつ１つの表にまとめるのに使っていました。
処理対象行の上に行を挿入していますが、これだと書式が想定した内容にならないと思うので、この処理を改善した方が良さそうです。処理対象行の下に行を挿入して、その後処理対象行の上に移動しつつ、１列目の値のみ移動する、のが良いでしょうかね。
Windows版をMacで実行した際の修正点
特にありません。