同じデータのセルを結合する

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

しかし、

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

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

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

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

 

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

 

だからといって、手動で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

※コードの使用方法

SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。

 

プログラムの説明

• 割愛

 

実行風景

縦方向・横方向のどちら側に選択しているかはプログラムが自動判別してくれます。

集計の機能を犠牲にして、刹那的に見やすくするだけの他愛のないコードですね（￣ｑ￣;）

 

 冒頭でも触れましたが、公の場でセル結合を乱用すると謎の勢力に命を狙われますので、その点は注意して下さい。