今日を乗り切るExcel研究所

Excel に働かされていませんか

複数範囲のセルの結合を一括でやりたい

セル結合を効率的に行う手順を検証します。また、複数範囲のセル結合を一括で処理するマクロを作成します。

f:id:shego:20170507234453p:plain

セルの結合の作業コスト

セルの結合を駆使した美しいレイアウトの Excel 文書を見ると、その作業コストを想像して軽く目眩がします。

1個1個のセル結合は簡単なのですが、何か所にもなると一辺にできないのでコツコツと時間のかかる作業です。

できればセル結合自体を止められればいいのですが、現実的にはセルを結合して作られた文書を編集しなければならないような状況はよくあります。

セルの結合の操作をもう少し効率よく方法があればいいのですが。

手作業で複数範囲のセルを結合するには

結合領域の指定と[セルの結合]コマンドの実行の繰り返しどうすれば素早くできるを考えてみます。

まず[セルの結合]のショートカットですが、Excel には標準で用意されていないようです。

ネットを検索すると、すでに多くのサイトで Excelをカスタマイズして[セルの結合]にショートカットを割り当てる方法が紹介されています。

ここではあえてカスタマイズなしで、単純にコマンドの再実行(Redo)の繰り返しで済ませる方向で考えます。

Excel で使える 再実行のショートカットにはF4Ctrl + YAlt + Enter などがあります。

この3つの中ではAlt + Enterが一番「指回り」がいい感じです。

「セルの結合」コマンドにもいくつか種類がありますが、やりたいコマンドを空実行しておけば、あとはAlt + Enterで繰り返せます。

次に複数範囲の選択ですが、マウス操作ならCtrlキーを押しながらセル範囲をドラッグしていけばいいです。

これと同じことをキー操作でやるには、Shift + F8を使います。

キー操作のセル移動が得意な人はこちらの方が速いかもしれません。

範囲選択しては結合を繰り返すのか、それとも複数範囲を選択後一括で結合するのか、どちらが速いかはパターンによるのでやってみるしかありません。

【手順例】

  1. あらかじめ、行いたい[セルの結合]のタイプを空実行しておきます
    • キー操作: AltHMC or A or M
  2. 結合範囲を選択します
    • 複数領域を選択したい場合
      • マウス操作: Ctrl を押しながら、セル範囲をドラッグします
      • キー操作: Shift + 矢印 でセル範囲を選択後、Shift + F8 で選択領域を追加します
  3. [セルの結合]を実行します
    • キー操作: Alt + Enter
  4. 指定した領域ごとにセルが結合されます
  5. 2.と3.を繰り返します

セル移動が得意で、手が慣れれば少しは高速に操作できるかもしれません。

 



空白セルを結合するマクロ

複数個所のセル結合を一括で行うマクロを作成してみました。

結合するセル範囲を選択する代わりに、セルの内容で自動的に判断させたいと思います。

下記の VBA プログラムは基本的に選択範囲にある連続する空白セルをまとめて結合しますが、見出しの空白でないセルの位置を結合範囲の基準として判断します。

言葉で説明するより下図を見たほうが早いでしょう。

ヨコ結合とタテヨコ結合の2パターンのマクロを用意しました。

そのほかの複雑なパターンへの対応は避けたいところですが、いつか遭遇したらその時にまた別の課題とします。

空白セルの結合_ヨコ

「空白セルの結合_ヨコ」マクロは選択範囲を[横方向に結合]します。

選択範囲の1行目のセルに飛び飛びで値(見出し)があると、右側にある空白セルを結合し、2行目以降は1行目に合わせてヨコ結合されます。

f:id:shego:20170501044952p:plain

空白セルの結合_タテヨコ

「空白セルの結合_タテヨコ」マクロは、選択範囲の1行目と1列目の値(見出し)のあるセルを基準にしてタテヨコに区切られたセル結合をします。

f:id:shego:20170501045016p:plain

Option Explicit

Sub 空白セルの結合_ヨコ()
    Selection.Cells.UnMerge
    mergeRightBlankCells Selection.Cells
End Sub

Sub 空白セルの結合_タテヨコ()
    Selection.Cells.UnMerge
    mergeBlankCells Selection.Cells
End Sub

Private Sub mergeRightBlankCells(rng As Range, Optional isAcross As Boolean = True)
    If rng.Columns.Count = 1 Then Exit Sub

    Dim blanks As Range
    Set blanks = rng.Rows(1).SpecialCells(xlCellTypeBlanks)
    blanks.Merge
    
    Dim leftOffset As Integer
    Dim bottomOffset As Integer
    bottomOffset = rng.Rows.Count - 1

    Dim mrg As Range
    For Each mrg In blanks.Areas
        leftOffset = IIf(mrg.Column > rng.Column, -1, 0)
        On Error Resume Next
        Range(mrg.Offset(bottomOffset, leftOffset), mrg).Merge isAcross
        On Error GoTo 0
    Next
End Sub

Private Sub mergeDownBlankCells(rng As Range)
    If rng.Rows.Count = 1 Then Exit Sub
    
    Dim blanks As Range
    Set blanks = rng.Columns(1).SpecialCells(xlCellTypeBlanks)
    blanks.Merge
    
    Dim rightOffset  As Integer
    Dim topOffset As Integer
    rightOffset = rng.Columns.Count - 1

    Dim mrg As Range
    For Each mrg In blanks.Areas
        topOffset = IIf(mrg.Row > rng.Row, -1, 0)
        On Error Resume Next
        Range(mrg.Offset(topOffset, rightOffset), mrg).Merge
        On Error GoTo 0
    Next
End Sub

Private Sub mergeBlankCells(rng As Range)
    If rng.Cells.Count = 1 Then Exit Sub

    mergeRightBlankCells rng.Rows(1)
    mergeDownBlankCells rng.Columns(1)
        
    Dim cx As Range
    Dim cy As Range
    For Each cx In rng.Rows(1).Cells
        If cx.Row = cx.MergeArea.Row Then
            For Each cy In rng.Columns(1).Cells
                If cy.Column = cy.MergeArea.Column Then
                    On Error Resume Next
                    Intersect(cx.MergeArea.EntireColumn, cy.MergeArea.EntireRow).Merge
                    On Error GoTo 0
                End If
            Next
        End If
    Next
End Sub

【使い方】

  1. 上記 VBA プログラムを標準モジュールにコピー&ペーストします
  2. 結合範囲を選択します
    • あらかじめ、1行目や1列目に結合範囲の位置を示すセル値を入力しておきます
  3. マクロを実行します
  4. 複数領域のセルが結合されます。

【注意】 操作の取り消し(Undo)はできません
 

【注意】 結合範囲の複数のセルに値があると、そのデータが失われます。 その場合、警告ダイアログが表示されますので、「キャンセル」を押して、データの様子を確認してください。
f:id:shego:20170501042820p:plain
万一データが失われても、当方の責任は負いかねます。

Windows 10 の Excel 2013 で動作確認しました。

関連記事

www.shegolab.jp