【VBA】セル結合を一括解除してデータを整形する方法（コピペOK）

VBA

2026.04.012026.04.26

この記事でできること
完成イメージ（Before / After）
どんな場面で使う？
事前準備
手順（コピペ → 動作確認まで約5分）
コード（基本版）– セル結合を一括解除する
コード（応用版）– 結合解除後に値を下方向にフィル
1. 書き換えポイント
2. コードの流れ
コード（実務版）– 結合だらけの帳票をデータベース形式に変換
1. 書き換えポイント
2. コードの流れ
よくある落とし穴5選
FAQ
まとめ
1. 関連記事
次にやりたくなること

この記事でできること

VBAでシート内のセル結合を一括解除できる
結合解除後の空白セルに、元の値を下方向にフィルできる
結合だらけの帳票を、フィルターやVLOOKUPが使えるデータベース形式に変換できる

対象: Excel 2016以降 / Microsoft 365、Windows 10/11

—

完成イメージ（Before / After）

Before（結合セルだらけの帳票）

	A（部署）	B（氏名）	C（売上）
1	部署	氏名	売上
2	営業（結合:2-4行）	田中	50,000
3		鈴木	30,000
4		佐藤	45,000
5	経理（結合:5-6行）	高橋	60,000
6		伊藤	35,000

A列の「営業」「経理」がセル結合されている。この状態ではフィルターで「営業」を絞り込めない。VLOOKUPも正しく動かない。

After（結合解除＋値フィル後）

	A（部署）	B（氏名）	C（売上）
1	部署	氏名	売上
2	営業	田中	50,000
3	営業	鈴木	30,000
4	営業	佐藤	45,000
5	経理	高橋	60,000
6	経理	伊藤	35,000

全行にデータが入っている。フィルターで「営業」を絞り込める。VLOOKUPもピボットテーブルも正常に使える。

—

他部署から届く月次報告書が、セル結合だらけだった。「営業」が3行結合、「経理」が2行結合。見た目はきれいだけど、フィルターをかけると「営業」で絞り込んでも1行しか表示されない。VLOOKUPで部署を引こうとしても、結合の2行目以降は空白扱いでエラーになる。

手作業で結合を1つずつ解除して、空白セルに値をコピペしていた。30行ぐらいならまだいいけど、500行の帳票が来たときは心が折れかけた。

VBAで一括解除＋値フィルを覚えてからは、500行でも3秒で終わる。結合セルに毎月苦しめられている人に、この方法を知ってほしい。

セル結合は「見た目のための機能」であって「データのための機能」ではない。VBAで解除してデータベース形式に戻せば、Excelの本来の力を引き出せる。

なお、結合解除後に不要な空白行が残る場合は空白行・空白セルを一括で削除する方法で一括削除できる。書式が崩れた場合はセルの書式を一括変更する方法で整えるとよい。

—

どんな場面で使う？

他部署から届く帳票がセル結合だらけで、フィルターやVLOOKUPが使えない
ピボットテーブルの元データにセル結合が含まれていて集計が正しくできない
結合を手動で1つずつ解除して値を埋め直す作業に毎回時間を取られている
結合だらけのExcelを「データベース形式」に変換してデータ分析に使いたい

—

事前準備

バックアップを取る

結合解除は元に戻せないことがある。 VBAで実行した操作はCtrl+Zで戻せない場合が多い。実行前に必ずファイルのコピーを別フォルダに保存しておくこと。

Excelをマクロ有効ブック（.xlsm）で保存する

Excelを開く（新規でも既存でもOK）
「ファイル」→「名前を付けて保存」
ファイルの種類を 「Excel マクロ有効ブック (*.xlsm)」 に変更して保存

.xlsx のままだとマクロが保存されない。必ず .xlsm にすること。

VBE（コードを書く画面）を開く

Alt + F11 キーを押すとVBE（Visual Basic Editor）が開く。

標準モジュールを挿入する

VBEのメニューで「挿入」→「標準モジュール」をクリック
右側にコードウィンドウが開く → ここにコードを貼り付ける

—

手順（コピペ → 動作確認まで約5分）

上の「事前準備」でVBEを開き、標準モジュールを挿入する
下の「コード（基本版）」をコピーして、コードウィンドウに貼り付ける
Alt + F8 を押してマクロ一覧を表示
マクロ名を選択して「実行」をクリック
セル結合が解除されていれば成功

ボタンに割り当てれば毎回Alt+F8を押さなくて済む。方法はマクロをボタン1つで実行する方法を参照。

—

コード（基本版）– セル結合を一括解除する

まずはこれだけで動く。アクティブシートのすべてのセル結合を一括解除する。


'============================================================
' ■ セル結合を一括解除する（基本版）
'   → シート全体の結合を UnMerge で一括解除
'   → 結合解除後、左上セル以外は空白になる
'============================================================
Sub セル結合を一括解除する()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    '--- 結合セルがあるか確認
    '    UsedRange全体をチェックするため、シートが大きい場合は
    '    数秒かかることがある
    Dim cell As Range
    Dim hasMerge As Boolean
    hasMerge = False

    For Each cell In ws.UsedRange
        If cell.MergeCells Then
            hasMerge = True
            Exit For
        End If
    Next cell

    If Not hasMerge Then
        MsgBox "結合セルはありませんでした。", vbInformation
        Exit Sub
    End If

    '--- 確認ダイアログ
    If MsgBox("セル結合を一括解除します。" & vbCrLf & _
              "解除後、結合の2行目以降は空白になります。" & vbCrLf & _
              "よろしいですか？", vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If

    '--- 一括解除
    ws.Cells.UnMerge

    MsgBox "セル結合を一括解除しました。", vbInformation

End Sub

コードの動作：

アクティブシートを取得する
UsedRange内に結合セルがあるか確認する（MergeCells プロパティで判定）
結合セルがなければメッセージを出して終了する
確認ダイアログで Yes/No を選択する
Cells.UnMerge でシート全体の結合を一括解除する

重要: UnMerge で結合を解除すると、結合範囲の左上セルにのみ値が残り、他のセルは空白になる。値を保持したい場合は応用版を使う。

—

コード（応用版）– 結合解除後に値を下方向にフィル

基本版では結合を解除すると左上セル以外が空白になってしまう。応用版では、結合セルの値を保持してから解除し、空白セルに値を下方向にフィルする。

自分もこの「値フィル」を入れてからは、結合解除後の手作業がゼロになった。基本版だけだと空白セルを1つずつ埋める手間が発生する。応用版なら解除と同時に値が埋まる。


'============================================================
' ■ 結合解除＋値を下方向にフィル（応用版）
'   → 結合セルの値を保持してから解除
'   → 空白セルに上のセルの値をコピー（下方向フィル）
'============================================================
Sub 結合解除して値をフィルする()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    '--- ★書き換えポイント ---
    Dim targetCol As String
    targetCol = "A"                '← 結合を解除する列
    Dim startRow As Long
    startRow = 2                   '← データ開始行（ヘッダーの次）
    '--- ★ここまで ---

    '--- 最終行を取得
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, targetCol).End(xlUp).Row

    If lastRow < startRow Then
        MsgBox "データがありません。", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False

    '--- 結合セルを検出 → 値を保持 → 解除 → フィル
    Dim r As Long
    Dim mergeVal As Variant

    r = startRow
    Do While r <= lastRow
        Dim targetCell As Range
        Set targetCell = ws.Range(targetCol & r)

        If targetCell.MergeCells Then
            '--- 結合セルの値を保持
            mergeVal = targetCell.MergeArea.Cells(1, 1).Value

            '--- 結合範囲の行数を取得
            Dim mergeRows As Long
            mergeRows = targetCell.MergeArea.Rows.Count

            '--- 結合を解除
            targetCell.MergeArea.UnMerge

            '--- 解除後の空白セルに値をフィル
            Dim fillRow As Long
            For fillRow = r To r + mergeRows - 1
                ws.Range(targetCol & fillRow).Value = mergeVal
            Next fillRow

            '--- 次の結合セルの位置へ移動
            r = r + mergeRows
        Else
            r = r + 1
        End If
    Loop

    Application.ScreenUpdating = True

    MsgBox targetCol & "列の結合を解除し、値をフィルしました。", vbInformation

End Sub

書き換えポイント

変数	説明	初期値
`targetCol`	結合を解除する列	`"A"`
`startRow`	データ開始行（ヘッダーの次）	`2`

コードの流れ

対象列と開始行を設定: targetCol と startRow で処理範囲を指定する
最終行の取得: Cells.End(xlUp).Row でデータの最終行を特定する
Do Whileループで結合セルを検出: MergeCells が True のセルを見つける
値を保持: MergeArea.Cells(1, 1).Value で結合範囲の左上セルの値を取得する
結合解除: MergeArea.UnMerge で結合を解除する
値フィル: 解除後の空白セルすべてに保持した値を代入する
位置を移動: 結合範囲の分だけスキップして次のセルへ進む

ポイント: MergeArea は結合されたセル範囲を返すプロパティ。結合の左上セルの値（Cells(1, 1).Value）を取得してから解除し、空白セルにフィルする。この順番が重要。

—

コード（実務版）– 結合だらけの帳票をデータベース形式に変換

実務では複数列が結合されている帳票が多い。A列の「部署」が3行結合、B列の「課」が2行結合、のように列ごとに結合範囲が異なる。実務版では、指定した複数列の結合を一括で解除し、すべての空白セルに値をフィルする。

以前、取引先から届く月次報告書が「部署」「課」「担当者区分」の3列で結合されていた。A列だけ解除しても、B列とC列の結合が残っていてフィルターが使えない。3列を1つずつ処理するのは面倒だったので、配列で対象列を管理するようにした。これで何列結合されていても1回の実行で済む。

文字列の表記ゆれ（全角半角、株式会社と(株)など）も同時に直したい場合は、セルの文字列を一括置換する方法と組み合わせるとよい。


'============================================================
' ■ 結合だらけの帳票をデータベース形式に変換（実務版）
'   → 複数列の結合を一括解除
'   → 解除後の空白セルに値を下方向フィル
'   → 処理前の確認＋件数報告
'============================================================
Sub 結合帳票をDB形式に変換する()

    '--- ★書き換えポイント ---
    Dim targetSheet As String
    targetSheet = "報告"           '← 対象シート名

    Dim startRow As Long
    startRow = 2                   '← データ開始行（ヘッダーの次）

    '--- 結合を解除する列の配列（必要に応じて追加）
    Dim targetCols As Variant
    targetCols = Array("A", "B")   '← 結合されている列を指定
    '--- ★ここまで ---

    Dim ws As Worksheet
    On Error Resume Next
    Set ws = ThisWorkbook.Worksheets(targetSheet)
    On Error GoTo 0

    If ws Is Nothing Then
        MsgBox "シート「" & targetSheet & "」が見つかりません。", vbExclamation
        Exit Sub
    End If

    '--- 最終行を取得（A列基準）
    '    結合列と異なる列（データが1行ずつ入っている列）を
    '    基準にするとより正確に取得できる
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    If lastRow < startRow Then
        MsgBox "データがありません。", vbExclamation
        Exit Sub
    End If

    '--- 確認ダイアログ
    If MsgBox("シート「" & targetSheet & "」の結合を解除し、" & vbCrLf & _
              "データベース形式に変換します。" & vbCrLf & _
              "対象列: " & Join(targetCols, ", ") & vbCrLf & _
              "対象行: " & startRow & " 〜 " & lastRow & " 行" & vbCrLf & vbCrLf & _
              "よろしいですか？", vbYesNo + vbQuestion) = vbNo Then
        Exit Sub
    End If

    '--- 高速化設定
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    On Error GoTo ErrHandler

    Dim colIdx As Long
    Dim r As Long
    Dim mergeVal As Variant
    Dim mergeCount As Long
    mergeCount = 0

    '--- 列ごとにループ
    For colIdx = LBound(targetCols) To UBound(targetCols)
        Dim col As String
        col = targetCols(colIdx)

        r = startRow
        Do While r <= lastRow
            Dim targetCell As Range
            Set targetCell = ws.Range(col & r)

            If targetCell.MergeCells Then
                '--- 結合セルの値を保持
                mergeVal = targetCell.MergeArea.Cells(1, 1).Value

                '--- 結合範囲の行数を取得
                Dim mergeRows As Long
                mergeRows = targetCell.MergeArea.Rows.Count

                '--- 結合を解除
                targetCell.MergeArea.UnMerge

                '--- 空白セルに値をフィル
                Dim fillRow As Long
                For fillRow = r To r + mergeRows - 1
                    If ws.Range(col & fillRow).Value = "" Then
                        ws.Range(col & fillRow).Value = mergeVal
                    End If
                Next fillRow

                mergeCount = mergeCount + 1
                r = r + mergeRows
            Else
                r = r + 1
            End If
        Loop
    Next colIdx

CleanUp:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    MsgBox mergeCount & " 箇所の結合を解除し、値をフィルしました。" & vbCrLf & _
           "対象シート: " & targetSheet, vbInformation
    Exit Sub

ErrHandler:
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "エラーが発生しました: " & Err.Description, vbExclamation

End Sub