シーゴの Excel 研究室

タイトル変更しました (旧称:今日を乗り切るExcel研究所)

結合セルをコピー&ペーストしたい

結合セルのコピー&ペーストを行う手順と、それを自動化するマクロを検討します。

結合セルはコピペがめんどうくさい

結合セルの何が困ると言えば、コピー&ペーストが思うようにできないことが一番ではないでしょうか。

特に方眼紙 Excelで、わざわざ結合セルで組まれた表からセルの値を取り出さなければならないときには、どうにもこうにもできずイライラの極致に達します。

結合セルは、通常の結合なしセルに貼り付けたり、また逆に通常セルから結合セルに貼り付けようとすると、貼り付け先が壊されたり、エラーになったりします。

1セルずつなら結合していてもなんとかコピーできるようですが、複数セル範囲になるともうだめです。あの手この手で試しても、何だかんだ言って断られます。

  • 「この操作は結合したセルには行えません。」
  • 「コピー領域と貼り付け領域のサイズが違うため、貼り付けることができません。」
  • 「この操作を行うには、すべての結合セルを同じサイズにする必要があります。」

結合セルに関係なく、値だけを簡単にコピー&ペーストをする方法はないのでしょうか。

結合セルの値のみをコピー&ペーストするには

結合セルを1個ずつコピーする

結合セルから結合セルへのコピーは基本的に出来ないのですが、条件によっては可能となります。

まず、セル1個ずつなら、結合セル間でもコピー&ペーストができるようです。

複数セルの場合でも、結合セルの構成(形や数)が完全に一致する領域間なら普通に可能です。 しかし、結合セルの構成に食い違いがあると、どうしてもエラーになります。

片方が通常セルの場合、1通常セル→1結合セルは問題なくコピペできますが、1結合セル→1通常セルでは結合状態も貼り付けされてしまいます。

結合セルから通常セルへ値のみコピーする

結合セルを含む領域を、通常の領域に普通にコピー&ペーストすると、値だけでなく、セルの結合状態もそのまま貼付けされて、コピー先が壊されてしまいます。

貼り付けをしたいのは、セルの値のみです。

そこで、今度は値のみで貼り付けをしてみます(「形式を選択して貼り付け」で「値」を選択)。 すると、セルの結合なしで値だけが貼付けられます。

これで、結合セルから値だけを取り出せたことにはなります。 ただし、複数セルを値のみで貼り付けてみると、値の位置がバラバラに散ってしまいます。

これらを詰めて寄せるには、いったん作業領域に貼り付けをして、一つ一つコピペで集めなければなりません。 それなら、最初から一個ずつコピペするのと変わりません。

ただ、もし値のセルが、タテヨコきれいにそろっていたら、以下のセルを寄せる小技が使えます。

  1. タテヨコに飛びとびの値のあるセル範囲を選択します
  2. 「ホーム」>「検索と選択」>「条件を選択してジャンプ」>「定数」を指定して「OK」します
    • 値のあるセルのみが複数選択されている状態になります
    • セルの数が少なければ Ctrlキーを押しながらのクリックで複数セル選択をしたほうが早いです
  3. このままコピーして別の空き場所で貼り付けます
    • バラバラだったセルが隙間なく、貼り付けられます

1カ所でも値セルの位置がずれたり欠けたりしているとと、もうコピーをさせてもらえないのでこの手順は使えません。

通常セルから結合セルへ値のみコピーする

先ほどの「書式なし」でバラバラに貼付けられたセルの位置関係をよく見直してみます。 結合が解けた値が残されたセルの位置は、どれも結合セルの左上角のセルに対応します。

どうも結合セルとは、この左上セルにつけられた書式の一種ということのようです。 つまり、セル結合とは本当にセルの構造を結合しているわけではなく、書式による単なる見せかけに過ぎないようです。

逆にいうと、このフォーメーションに合わせたセルを用意しておけば、書式なしの貼り付けをすることで、結合セルへ値をコピーすることができるはずです。

  1. 作業用領域で結合セルの左上角に対応するセルに値を配置します
  2. 作業用領域をコピーしします
  3. 元の結合セルのある貼り付け先を選択し、値のみ貼り付けます。
    • 「形式を選択して貼り付け」で「数式」あるいは「数式と数値の書式」を実行します。
    • なぜか「値」や「値と数値の書式」ではうまくいきません。
  4. 結合セルへ値のみ貼り付けられます。

作業領域に値を一つずつ配置するのもまた面倒なことですが、これを軽減する小技はなさそうです。

結局

とりあえず、「貼り付けの形式」で「値」や「数式」を使えばとりあえず結合セルの中身だけを取り出すことができました。

ただ、キレイにデータを配置するには、いったん作業領域を使うなど効率が良くありません。 一発で結合セルを一括コピー&ペーストできる方法はなさそうです。

マクロを使えばなんとかなるかもしれません。

 



 

結合セルの値をコピー&ペーストするマクロ

Excel が結合セルのコピーをさせてくれないのには何か理由があるのかもしれません。

そこは気にしないことにして、結合セルの値のみをコピペするマクロを作成してみることにします。

下記 VBA マクロで、結合セルを含む領域を普通にコピー&ペーストできます。

結合セルを含むセル範囲を本マクロでコピーすると、コピー先を壊さずに値のみ貼り付けされます。 結合セルから通常セルへ、逆に通常セルから結合セルへ、あるいは結合セル同士の間でもかまいません。

本マクロのロジックはセルを1個ずつたどって地道に値をコピーするものです。 比較的重い処理になりますので、大きなシートでの使用は避けたほうがいいでしょう。

また、複雑な結合をしたセル領域に対する使用もあまりお勧めしません。 結合セルが入れ違いで組み合わされているような状況でも動作はするのですが、どのセルがどこのセルへコピーされるか予想がつかず、抜け漏れもあるかもしれません。

マクロを「マクロの実行」ダイアログから実行する場合と、ショートカットやボタンに割り付ける場合とでは、使い方と挙動が多少異なりますので注意してください。

Option Explicit

Sub 結合セルをコピー_値のみ()
    Dim copyRange As Range
    Dim pasteRange As Range
    
    If Application.CutCopyMode = xlCopy Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        
        Set pasteRange = Selection.Cells(1, 1)
        With Workbooks.add
            With .ActiveSheet
                .Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
                .Range("A1").PasteSpecial xlPasteFormats
                Set copyRange = .UsedRange

                copyMergedCellsValue copyRange, pasteRange
            End With
            .Close SaveChanges:=False
        End With
        
        Application.EnableEvents = True
        Application.ScreenUpdating = True
        
    ElseIf TypeName(Selection) = "Range" Then
        On Error Resume Next
        Set copyRange = Application.InputBox(prompt:="コピー元のセル範囲を選択してください", default:=Selection.Address, Type:=8)
        If copyRange Is Nothing Then Exit Sub
        Set pasteRange = Application.InputBox(prompt:="貼り付け先を選択してください", Type:=8)
        If pasteRange Is Nothing Then Exit Sub
        On Error GoTo 0
        
        Application.ScreenUpdating = False
        
        copyMergedCellsValue copyRange, pasteRange
    
        Application.ScreenUpdating = True
    End If
    
End Sub

Private Sub copyMergedCellsValue(src As Range, dst As Range)
    Dim bottomRight As Range
    Dim srcRow As Range
    Dim srcCell As Range
    Dim dstRow As Range
    Dim dstCell As Range
    Dim dstAddrs As String
    
    Set bottomRight = src.Cells(src.Rows.Count, src.Columns.Count)
    Set srcRow = src.Cells(1, 1)
    Set dstRow = dst.Cells(1, 1)
    dstAddrs = dstRow.Address
    Do
        Set srcCell = srcRow
        Set dstCell = dstRow
        Do
            dstCell.Value = srcCell.Value
            dstCell.NumberFormatLocal = srcCell.NumberFormatLocal
            dstAddrs = Union(Range(dstAddrs), Range(dstCell.MergeArea.Address)).Address
            Set srcCell = srcCell.Offset(0, 1)
            Set dstCell = dstCell.Offset(0, 1)
        Loop While srcCell.Column <= bottomRight.Column
        Set srcRow = srcRow.Offset(1, 0)
        Set dstRow = dstRow.Offset(1, 0)
    Loop While srcRow.row <= bottomRight.row

    dst.Worksheet.Activate
    Range(dstAddrs).Select
End Sub

【使い方1】「マクロの実行」ダイアログ

  1. 上記 VBA プログラムを標準モジュールにコピー&ペーストします
  2. 「表示」タブ → 「マクロ」→ 「マクロの表示」を選択し、「マクロの実行」ダイアログを表示します
  3. 「マクロ名」リストから「結合セルをコピー_値のみ」マクロを選択し、「実行」します
  4. 最初の「入力」ダイアログで、コピー元のセル範囲を入力し、「OK」ボタンを押します
  5. 次の「入力」ダイアログで、コピー先のセル範囲を入力し、「OK」ボタンを押します
  6. 貼り付け先にコピー元の内容が入力されます

【使い方2】ショートカットやボタンに割り付け

  1. 上記 VBA プログラムを標準モジュールにコピー&ペーストします
  2. あらかじめ、このマクロにショートカットキーを割り付けるか、マクロボタンに登録します。
  3. コピー元のセル範囲をコピーします(Ctrl + C)
  4. 貼り付け先のセルを選択し、ショートカットキーやマクロボタンで実行します。
    • コピー中のセル範囲なしで実行した場合は【使い方1】と同様の動作になります
  5. 貼り付け先にコピー元の内容が入力されます

「切り取り(Cut)」したセル範囲の貼り付けはできません。

【注意】 結果を「元に戻す(Undo)」ことはできませんので、貼り付け先での上書きには注意してください。

【注意】 コピーされるのは値のみです。数式には対応していません。

【注意】 セル結合の形状によっては、値が欠落します。縦横のマス目のそろったセル結合範囲のみで実行してください。

  



追加:結合セルの値をコピー&ペーストするマクロその2

上記マクロは、「田の字」のようにマス目がそろったセル結合にしか対応していません。 複雑なセル結合をした範囲からコピーすると、一部値が欠如したりズレたりします。

もう少し凝ったセル結合からも値をとれるマクロを書いてみました。 以下のような状況で改善があります。

  • 複雑なセル結合
  • 非表示のセルの値は取り出さない

先のマクロでは「田の字」状にマス目になったセル結合にしか対応していませんでしたが、このマクロでは複雑な形状のセル結合があっても位置関係を崩さずに最少のセル範囲にまとめられて貼り付けされます。

また、セル結合を含むリストでフィルター(絞り込み)などにより非表示になったセルがあったとしても、表示されているセルの値のみを正しくコピーします。

ただし、

  • セル結合範囲 ⇒ 非セル結合範囲へのコピーのみ対応

という制約があります。 つまり、セル結合のある範囲への貼り付けには対応しておらず、使用とするとエラーになります。

使い方は、先のマクロと同様です。 不具合等ありましたらコメントやTwitter でお知らせください。

Option Explicit

Sub 結合セルをコピー_値のみ_2()
    If TypeName(Selection) <> "Range" Then Beep: Exit Sub

    Dim rngCopy As Range
    Dim rngPaste As Range
    
    If Application.CutCopyMode = xlCut Then
        Beep
        Exit Sub
    ElseIf Application.CutCopyMode = xlCopy Then
        Application.ScreenUpdating = False
        Set rngCopy = getCopyRange()
        Application.ScreenUpdating = True
        If rngCopy Is Nothing Then Beep: Exit Sub
        Set rngPaste = Selection.Cells(1)
    Else
        Set rngCopy = CRange(Application.InputBox(prompt:="コピー元のセル範囲を選択してください", Default:=Selection.Address, Type:=8))
        If rngCopy Is Nothing Then Exit Sub
        Set rngPaste = CRange(Application.InputBox(prompt:="貼り付け先を選択してください", Type:=8))
        If rngPaste Is Nothing Then Exit Sub
    End If
    If rngCopy.Worksheet Is rngPaste.Worksheet Then
        If Not Intersect(rngCopy, rngPaste) Is Nothing Then Beep: Exit Sub ' セル範囲の重複を許さない
    End If
    
    Application.ScreenUpdating = False
    Dim wrk As Worksheet
    Set wrk = Worksheets.Add
    
    On Error GoTo finish
    Call copyVisible(rngCopy.Areas(1), wrk.Range("A1"))
    Call packAndCopy(wrk.UsedRange, rngPaste)

finish:
    If Err.Number <> 0 Then MsgBox Err.Description, vbExclamation + vbOK
    Application.DisplayAlerts = False
    wrk.Delete
    Application.DisplayAlerts = True
    rngPaste.Worksheet.Activate
    Application.ScreenUpdating = True
End Sub

Private Function getCopyRange() As Range
    If Application.CutCopyMode = False Then Exit Function
    With Worksheets.Add
        .Paste Link:=True
        
        Set getCopyRange = Range( _
            Range(.Range("A1").Formula), _
            Range(.UsedRange.Cells(.UsedRange.Count).Formula))
        If getCopyRange.Cells.Count <> .UsedRange.Cells.Count Then
            Set getCopyRange = Nothing ' とりあえず複数選択コピーは非対応
        End If
        
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Function

Sub copyVisible(ByVal src As Range, ByVal dst As Range)
    src.Worksheet.Copy Before:=src.Worksheet
    With ActiveSheet
        Dim tmp As Range
        Set tmp = .Range(src.Address)
        
        Call forEachMergedRange(tmp, "unmergeVisible")
        
        On Error Resume Next
        Set tmp = tmp.SpecialCells(xlCellTypeVisible)
        If Not tmp Is Nothing Then
            tmp.Copy
            dst.PasteSpecial xlPasteValuesAndNumberFormats
        End If
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
End Sub

Private Sub unmergeVisible(rng As Range)
    If Not rng.MergeCells Then Exit Sub
    
    Dim rngMerge As Range
    Dim rngVisible As Range
    
    Set rngMerge = rng.Cells(1).MergeArea
    rngMerge.UnMerge
    
    On Error Resume Next
    Set rngVisible = rngMerge.SpecialCells(xlCellTypeVisible)
    If rngVisible Is Nothing Then Exit Sub
    rngVisible.Cells(1).Value = rngMerge.Cells(1).Value
End Sub

Private Sub packAndCopy(src As Range, dst As Range)
    If src.Count = 1 Or WorksheetFunction.CountA(src) = 0 Then
        src.Copy dst
    Else
        With src.SpecialCells(xlCellTypeConstants) ' 空白行・空白列を詰めてコピー
            Intersect(.EntireRow, .EntireColumn).Copy
            dst.PasteSpecial xlPasteValuesAndNumberFormats
        End With
    End If
End Sub

Private Sub forEachMergedRange(rng As Range, proc As String)
    Dim col As Range
    Dim cur As Range
    Dim nxt As Range
    Dim overEnd As Long
    
    For Each col In rng.Columns ' 列方向優先
        If IsNull(col.MergeCells) Or col.MergeCells Then
            overEnd = col.Row + col.Rows.Count
            Set cur = col.Cells(1)
            Do
                Set nxt = cur.Offset(1)
                If cur.MergeCells Then
                    If cur.MergeArea.Cells(1).Address = cur.Address Then
                        Application.Run proc, cur
                    End If
                End If
                Set cur = nxt
            Loop While cur.Row < overEnd
        End If
    Next
End Sub

Private Function CRange(val As Variant) As Range
    Set CRange = IIf(TypeName(val) = "Range", val, Nothing)
End Function

【注意】 結果を「元に戻す(Undo)」ことはできませんので、貼り付け先での上書きには注意してください。

【注意】 コピーされるのは値のみです。数式には対応していません。

【注意】 セル結合のある範囲にはコピーできません。

 

【免責】 本記事で公開されたマクロ(VBAプログラム)はその機能や動作結果の正確性・正当性について本ブログの管理者が保証するものではありません。 また当プログラムの不具合や誤操作によって利用者に生じたいかなる損害・損失についても、本ブログの管理者は一切の責任を負うことはできませんので、利用に際しては予めご了承ください。 また、本記事のスクリプトプログラムは、あくまで個人の業務効率の改善に資することを目的としています。 使用に際しては出力内容を細心の注意をもって検証し、個人の責任の範囲内でご利用ください。

まとめ

セル結合のある範囲のコピーできない問題は古くから作業者を困らせてきました。 これが、セル結合を使ってはいけないという意見の理由の一つになっています。

今回値のみや数式のみの貼り付けでなんとか値を取り出しましたが、作業的に手間なのは変わりません。 また、結合セルから結合セルへの貼り付けとなるともうお手上げです。

実用には中途半端でもうちょっと配慮が欲しいところですが、それができないのもエクセルさんなりに何か理由があるのでしょう。

本記事の内容は Window 10 上の Excel 2013 と Micorsoft 365 版の Excel で動作確認しました。

関連記事

www.shegolab.jp

変更履歴

  • [2022/05/23] マクロその2を追加、一部本文修正。