Excel VBA 連続した同じ値のセル範囲を自動で結合する

'指定列で同じデータが連続した場合そのセル範囲を結合する
Sub MergeCellsCol()
    Dim rng As Range
    Dim tgr As Long
    Dim sr As Long, er As Long, col As Long
    'Application.InputBoxで列を指定できるようにする
    On Error Resume Next
    Set rng = Application.InputBox( _
        Prompt:="対象列のセル範囲を選択指定するか" & vbCrLf & _
        "先頭セルを選択してください！", Title:="対象セル選択", Type:=8)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub
    '選択された先頭セルの行と列の番号を取得します
    sr = rng.Row
    col = rng.Column
    'セル選択状態を判定して最終行を取得します
    If rng.Count = 1 Then
        er = Cells(Rows.Count, col).End(xlUp).Row '先頭だけ選択の場合
    Else
        er = sr + rng.Count - 1 '範囲で選択している場合
    End If
    Set rng = Cells(sr, col)    '先頭セルをRangeオブジェクト変数に代入
    
    For tgr = sr To er - 1      '最終行の一つ手前までループ処理
        With Cells(tgr, col)
            '次のセルとセルの値を比較して同じ間はセル範囲を広げます
            If .Value = .Offset(1, 0).Value Then
                Set rng = Union(rng, .Offset(1, 0))
            Else
            '値が違うセルが出現したら広げていた範囲を結合します
                Application.DisplayAlerts = False
                rng.Merge
            '    rng.HorizontalAlignment = xlHAlignCenter '横中央
                rng.VerticalAlignment = xlVAlignCenter   '縦中央
                Application.DisplayAlerts = True
                Set rng = .Offset(1, 0)     '次のセルをRange変数に代入
            End If
        End With
    Next
    '範囲の一番最後が前のセルと同じだった場合の結合処理
    If rng.Count > 1 Then 'Range変数が複数だった場合結合します
        Application.DisplayAlerts = False
        rng.Merge
    '    rng.HorizontalAlignment = xlHAlignCenter '横中央
        rng.VerticalAlignment = xlVAlignCenter   '縦中央
        Application.DisplayAlerts = True
    End If
End Sub

'指定行で同じデータが連続した場合そのセル範囲を結合する
Sub MergeCellsRow()
    Dim rng As Range
    Dim Row As Long, tgc As Long
    Dim sc As Long, ec As Long
    Dim i, j As Long
    'Application.InputBoxで列を指定できるようにする
    On Error Resume Next
    Set rng = Application.InputBox( _
        Prompt:="対象行のセル範囲を選択指定するか" & vbCrLf & _
        "行の先頭セルを選択してください！", Title:="対象セル選択", Type:=8)
    On Error GoTo 0
    If rng Is Nothing Then Exit Sub
    '選択された先頭セルの行と列の番号を取得します
    Row = rng.Row
    sc = rng.Column
    'セル選択状態を判定して最終列を取得します
    If rng.Count = 1 Then
        ec = Cells(Row, Columns.Count).End(xlToLeft).Column '先頭だけ選択の場合
    Else
        ec = sc + rng.Count - 1 '範囲で選択している場合
    End If
    Set rng = Cells(Row, sc)    '先頭セルをRangeオブジェクト変数に代入
    
    For tgc = sc To ec - 1      '最終列の一つ手前までループ処理
        With Cells(Row, tgc)
            '次のセルとセルの値を比較して同じ間はセル範囲を広げます
            If .Value = .Offset(0, 1).Value Then
                Set rng = Union(rng, .Offset(0, 1))
            Else
             '値が違うセルが出現したら広げていた範囲を結合します
               Application.DisplayAlerts = False
                rng.Merge
                rng.HorizontalAlignment = xlHAlignCenter '横中央
                'rng.VerticalAlignment = xlVAlignCenter   '縦中央
                Application.DisplayAlerts = True
                Set rng = .Offset(0, 1)    '次のセルをRange変数に代入
            End If
        End With
    Next
    '範囲の一番最後が前のセルと同じだった場合の結合処理
    If rng.Count > 1 Then 'Range変数が複数だった場合結合します
        Application.DisplayAlerts = False
        rng.Merge
        rng.HorizontalAlignment = xlHAlignCenter '横中央
        'rng.VerticalAlignment = xlVAlignCenter   '縦中央
        Application.DisplayAlerts = True
    End If
End Sub