【Excel VBA】縦方向に連続する同じ値のセルを自動結合

Excelで集計・分析を考慮すると、セルを結合しないことが推奨されますが、表を見やすくするために同じ値のセルを結合したいことがあります。

この場合、個人的には、【Excel】セルを結合せずに「条件付き書式」で見やすい表に一括変換を第一選択としています。

しかし、セルの中央に文字をレイアウトしたい場面や、文字数が多い場合などはセル結合をしたくなることもあり、マクロで「縦方向に連続する同じ値のセルを自動結合」のサンプルです。

内容：

アウトプットイメージ
事例の前提
シンプルな事例のVBA
左側列も考慮したVBA
事例のVBAと「条件付き書式」の設定例の対応
- 「シンプルな事例のVBA」に対応する条件付き書式の設定例
- 「左側列も考慮したVBA」に対応する条件付き書式の設定例
結合したセルを一括解除し、同じ値の入力
参考情報（サンプルファイルなど）

アウトプットイメージ

次のように、VBAで縦方向に連続する同じ値のセルを自動結合します。

VBAでセルを結合したアウトプットのイメージ — 縦方向に連続する同じ値のセルを結合

事例の前提

事前に、セルを結合をしたいセル範囲を選択しておきます（この事例では、B2:D9を選択）。
セル内の文字の上下位置等もVBAで設定しないため、上揃えや上下中央揃えは実行の前後（どちらでも可）にしておきます。
VBAを実行すると、選択されたセル範囲について、縦方向に連続する同じ値があるとセル結合します。

シンプルな事例のVBA

選択されたセル範囲の各列のみをチェックします。

前述のアウトプットイメージのように、左側列の値も考慮したセル結合をしたい場合のサンプルは、次項の左側列も考慮したVBAです。

Sub 縦方向で連続して同じ値のセルを自動結合()
    Dim 選択範囲 As Range
    Dim 最終行 As Long, 最終列 As Long, 行 As Long, 列 As Long
    Dim 結合開始行 As Long
    Dim 当該列の比較値 As String

    Set 選択範囲 = Selection
    
    最終行 = Selection.Rows.Count
    最終列 = Selection.Columns.Count
    Application.DisplayAlerts = False
        
    For 列 = 1 To 最終列
    
        結合開始行 = 1
        当該列の比較値 = 選択範囲.Cells(1, 列).Value
        
        For 行 = 2 To 最終行 '結合の判定を2行目からするので'
                        
            'セル結合の判定と処理’
            If 選択範囲.Cells(行, 列).Value = 当該列の比較値 Then
                Range(選択範囲.Cells(結合開始行, 列), 選択範囲.Cells(行, 列)).Merge
            Else
                結合開始行 = 行
                当該列の比較値 = 選択範囲.Cells(行, 列).Value
            End If
        
        Next 行
    Next 列
    Application.DisplayAlerts = True
End Sub

左側列も考慮したVBA

当該列と一つ左側の列で同じ値が連続しているかの一致状況も確認するサンプルです。
セル結合をしたい場面でいくと、こちらの用途も多いと思います。

Sub 左側列も考慮して縦方向で連続して同じ値のセルを自動結合()
    Dim 選択範囲 As Range
    Dim 最終行 As Long, 最終列 As Long, 行 As Long, 列 As Long
    Dim 結合開始行 As Long
    Dim 左側列 As Long
    Dim 当該列の比較値 As String
    Dim 当該列の一致判定 As Boolean, 左側列の一致判定 As Boolean

    Set 選択範囲 = Selection
    
    最終行 = Selection.Rows.Count
    最終列 = Selection.Columns.Count
    Application.DisplayAlerts = False
        
    For 列 = 最終列 To 1 Step -1 '左側を考慮する場合、最終列から見た方が処理しやすいので’
    
        結合開始行 = 1
        当該列の比較値 = 選択範囲.Cells(1, 列).Value
        左側列 = IIf(列 = 1, 1, 列 - 1) '最小値を1に設定'
        
        For 行 = 2 To 最終行 '結合の判定を2行目からするので'

            '当該列と左側列で一致判定。ただし左側列は1列目は範囲外なので除く'
            With 選択範囲
                当該列の一致判定 = IIf(.Cells(行, 列).Value = 当該列の比較値, True, False)
                左側列の一致判定 = IIf(列 = 1 Or .Cells(行, 左側列).Value = .Cells(行 - 1, 左側列).Value, True, False)
            End With
                        
            'セル結合の判定と処理’
            If 当該列の一致判定 And 左側列の一致判定 Then
                Range(選択範囲.Cells(結合開始行, 列), 選択範囲.Cells(行, 列)).Merge
            Else
                結合開始行 = 行
                当該列の比較値 = 選択範囲.Cells(行, 列).Value
            End If
        
        Next 行
    Next 列
    Application.DisplayAlerts = True
End Sub