Excelのデータ分類用カラムにグループ感を出すVBAマクロ

Excelでは左側に分類、右側にデータというレイアウトでデータを整理することが多いと思います。

そのとき左側の分類カラムがなんとなくグループ化されているとパッと見でわかりやすくて嬉しいですよね。

しかしセル結合は地雷ですし、条件付き書式でやるとうまく動かないことがあるので余計不便です。

やるなら罫線とフォント色なのですが、手作業でちまちまやるのは面倒ですよね。

そこで、ボタン一発でできるマクロを作りました（昔の自分が作っていました）ので共有したいと思います。

なにがどうなるか
マクロの使い方
VBAマクロのソースコード
注意事項
まとめ：マクロで自動化しよう

なにがどうなるか

上の図のとおりです。

左のようにバラバラと並んでいてグループ化されていないように見えるデータを、右のようなグルーピングがわかる見た目に整えます。

マクロでいじるのは罫線の設定とフォントの色だけなので、オートフィルタの邪魔をしません。

マクロの使い方

使い方ですが、特に難しいところはありません。

分類のところも含めてデータを全部埋めます
見た目を整えたい部分を選択します（データ行のみ）
マクロを起動します

以上です。

VBAマクロのソースコード

ソースコードは以下の通りです。

'選択エリア情報格納用
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 - 1
        .EndColIndex = Selection.Columns.Count + Selection.Column - 1
        .RowCount = Selection.Rows.Count
        .ColCount = Selection.Columns.Count
        .CurrentRowIndex = ActiveCell.Row
        .CurrentColIndex = ActiveCell.Column
    End With

    GetSelectionInfo = selInf

End Function

'選択エリアの表にグループ罫線を引く
Public Sub グループ罫線()
     
    Application.ScreenUpdating = False
     
    Dim colIdx As Long
    Dim rowIdx As Long
    Dim selInf As SelectionInfo 'シートの選択領域
 
    Dim lngAddCnt As Long   '追加行数
    lngAddCnt = 0
     
    '選択情報取得
    selInf = GetSelectionInfo()
     
    '最初のセルから正順(列優先)に処理を行なう
    For colIdx = selInf.StartColIndex To selInf.EndColIndex
        For rowIdx = selInf.StartRowIndex To selInf.EndRowIndex
            '罫線を引く
            With cells(rowIdx, colIdx)
                If .Value <> cells(rowIdx - 1, colIdx) Then
                    '値が上のセルと異なる場合罫線で囲う
                        .Borders(xlEdgeTop).LineStyle = True
                        .Borders(xlEdgeRight).LineStyle = True
                        .Borders(xlEdgeBottom).LineStyle = True
                        .Borders(xlEdgeLeft).LineStyle = True
                    '値が同じ場合、上罫線は消し、文字色を薄くする
                    Else
                        .Borders(xlEdgeTop).LineStyle = False
                        .Borders(xlEdgeRight).LineStyle = True
                        .Borders(xlEdgeBottom).LineStyle = True
                        .Borders(xlEdgeLeft).LineStyle = True
                        .Font.ColorIndex = 48
                End If
             End With
                 
        Next
    Next
    Application.ScreenUpdating = True
End Sub

グループ罫線()が本体です。その前の共通部分はその昔どこかからひっぱってきたものだと思います。

こちらを個人用のアドイン（*.xlam）に放り込んでおくと、ほかのファイルでも使いまわせて便利です。

参考アドインを追加または削除する – Excel

リボンにボタンを追加するとクリック一発で呼び出せるようになります。

参考 Office でリボンをカスタマイズする – Office サポート