同じデータのセルを結合する - VBAの勉強を始めてみた

今回は隣接するセルのデータが同じであれば、セル結合する。というコードを作ってみたいと思います。

しかし、

「セル結合はなるべく避けるべし」

「すぐにセル結合したがる民は滅んでほしい」

「最初からこの機能が無ければよかった」

と、いうような声もよく耳にします。
確かに、多くの人でデータを共有したりするようなエクセルシートであれば、エクセルの便利な機能が殺されてしまい、思わぬ迷惑をかけてしまうことがあります。
しかし、使い捨てで、他人に渡すようなものでなければ、見やすくするためにちょっとくらい結合したっていいじゃん。という思いもあったりします。

実際、私はよくやります。（←ぇ）

だからといって、手動で1個ずつ結合していくのも面倒くさいです。なので「縦方向（または横方向）に隣接するセルのデータが同じならセル結合する」というコードを作ってみました。禁忌を積極的に破るようで気が引けますけどね･･････。

Sub 同じデータのセルを結合する()
    Dim 列 As Long
    Dim 行 As Long
    Dim 行終 As Long
    Dim 列終 As Long
    Dim myUni As Range

    Application.DisplayAlerts = False

    If Selection.Rows.Count > 1 And Selection.Columns.Count = 1 Then    '下方向に選択したときの処理
        列 = Selection.Column
        行 = Selection.Row + 1
        行終 = Selection.Rows(Selection.Rows.Count).Row
        
        Do While 行 <= 行終
            If Cells(行 - 1, 列).MergeArea(1).Value = Cells(行, 列).MergeArea(1).Value Then
                If myUni Is Nothing Then
                    Set myUni = Range(Cells(行 - 1, 列), Cells(行, 列))
                Else
                    Set myUni = Union(myUni, Cells(行, 列))
                End If
            Else
                If Not myUni Is Nothing Then
                    myUni.Merge
                    Set myUni = Nothing
                End If
            End If
            
            行 = 行 + 1

        Loop
            
    ElseIf Selection.Rows.Count = 1 And Selection.Columns.Count > 1 Then '右方向に選択したときの処理
        行 = Selection.Row
        列 = Selection.Column + 1
        列終 = Selection.Columns(Selection.Columns.Count).Column
        
        Do While 列 <= 列終
            If Cells(行, 列 - 1).MergeArea(1).Value = Cells(行, 列).MergeArea(1).Value Then
                If myUni Is Nothing Then
                    Set myUni = Range(Cells(行, 列 - 1), Cells(行, 列))
                Else
                    Set myUni = Union(myUni, Cells(行, 列))
                End If
            Else
                If Not myUni Is Nothing Then
                    myUni.Merge
                    Set myUni = Nothing
                End If
            End If
            
            列 = 列 + 1

        Loop
        
    End If
    
    If Not myUni Is Nothing Then    '行終または列終を含むセルの結合
        myUni.Merge
    End If

End Sub