VBAサンプル集
セル結合/解除でセル値を退避/回復

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
公開日:2020-02-16 最終更新日:2020-02-16

セル結合/解除でセル値を退避/回復


セル結合の弊害はネットに溢れているのでここで改めて説明の必要はないでしょう。
とはいえ、セル結合したい場合もありますよね、人間だからね。


VBAで適切に処理すればセル結合もきちんと処理は可能です。

第85回.結合セルの扱い|VBA入門
・セル結合に関する、メソッド・プロパティ ・セル結合のマクロVBA使用例 ・セル結合時の値消去 ・指定セル範囲に結合セルが存在するか判定するマクロVBA ・セル結合時のOffsetとResizeの注意点

しかし、セル結合した時にどうしようもないのが、各セル値が失われてしまうことです。
セル結合すると、先頭セルの値だけが残り他のセル値は消えてしまいます。
これは、どうしようもありません。
そこで、セル結合した時にセル値をどこかに退避しておき、セル結合を解除した時に復元するVBAを考えてみました。


とはいえ、実際にこのVBAが必要になる事はほとんどないでしょう。
VBAを扱う人なら、セル結合があると面倒なことは承知しているはずですので、VBAで結合するという事自体が少ないでしょう。
さらに結合で失われる値を保持する必要がある場合などなかなか想定できません。
また、決してセル結合を推奨しているわけではないという事だけは申し上げておきます。
あくまで、セル結合等で失われてしまう情報の退避/回復方法のひとつとしてのサンプルVBAを提示してみたもになります。
従って、どちらかと言うとCustomDocumentPropertiesの使い方のサンプルになります。

セル結合/解除でセル値を退避/回復のVBA

'指定セル範囲をセル結合
Sub MergeRange(ByVal aRange As Range)
  If IsNull(aRange.MergeCells) Or aRange.MergeCells Then
    If MsgBox("結合セルが含まれています。" & vbLf & _
         "続行しますか?" & vbLf & vbLf & _
         "続行し場合、結合されているセルの値は失われます。", _
         vbYesNo + vbDefaultButton2, "確認") = vbNo Then
      Exit Sub
    End If
  End If
  Call StoreRange(aRange)
  Dim isDisplayAlerts As Boolean
  isDisplayAlerts = Application.DisplayAlerts
  Application.DisplayAlerts = False
  aRange.Merge
  Application.DisplayAlerts = isDisplayAlerts
End Sub

'指定セル範囲の先頭セルの結合範囲を解除
Sub UnMergeRange(ByVal aRange As Range)
  Set aRange = aRange.Item(1).MergeArea '先頭セル
  aRange.UnMerge
  Call RestoreRange(aRange)
  
  Dim wb As Workbook
  Set wb = aRange.Worksheet.Parent
  Dim myRange As Range
  For Each myRange In aRange
    Call DelCustomDocumentProperties(wb, myRange)
  Next
End Sub

'指定セル範囲をCustomDocumentPropertiesに退避
Sub StoreRange(ByVal aRange As Range)
  Dim myRange As Range
  For Each myRange In aRange
    Call AddCustomDocumentProperties(myRange)
  Next
End Sub

'指定セル範囲のValueとNumberFormatLocalをCustomDocumentPropertiesから復元
Sub RestoreRange(ByVal aRange As Range)
  Dim wb As Workbook
  Set wb = aRange.Worksheet.Parent
  
  Dim myRange As Range
  Dim sAddress As String
  For Each myRange In aRange
    If myRange.Address <> aRange.Item(1).Address Then '先頭セルは変更しない
      sAddress = aRange.Worksheet.Name & "!" & myRange.Address(False, False)
      myRange.Value = getCustomDocumentProperties(wb, sAddress & "_Value")
      myRange.NumberFormatLocal = _
        getCustomDocumentProperties(wb, sAddress & "_NumberFormatLocal")
    End If
  Next
End Sub

'指定文字列のCustomDocumentPropertiesを取得
Function getCustomDocumentProperties(ByVal wb As Workbook, _
                   ByVal aProperties As String) As String
  On Error Resume Next
  getCustomDocumentProperties = wb.CustomDocumentProperties(aProperties)
End Function

'指定セルのValueとNumberFormatLocalをCustomDocumentPropertiesへ退避
Sub AddCustomDocumentProperties(ByVal aRange As Range)
  Dim wb As Workbook
  Set wb = aRange.Worksheet.Parent
  
  Dim dps As DocumentProperties
  Dim sAddress As String
  Set dps = wb.CustomDocumentProperties
  sAddress = aRange.Worksheet.Name & "!" & aRange.Address(False, False)
  
  'CustomDocumentPropertiesから削除
  Call DelCustomDocumentProperties(wb, sAddress)
  
  'CustomDocumentPropertiesへ追加
  dps.Add sAddress & "_Value", False, msoPropertyTypeString, aRange.Value
  dps.Add sAddress & "_NumberFormatLocal", False, msoPropertyTypeString, aRange.NumberFormatLocal
End Sub

'指定セルのCustomDocumentPropertiesを削除
Sub DelCustomDocumentProperties(ByVal wb As Workbook, _
                ByVal aAddress As String)
  Dim dps As DocumentProperties
  Set dps = wb.CustomDocumentProperties
  Dim dp As DocumentProperty
  For Each dp In dps
    If dp.Name Like aAddress & "_*" Then
      dp.Delete
    End If
  Next
End Sub

CustomDocumentPropertiesについては、以下を参照してください。
ドキュメントプロパティ(BuiltinDocumentProperties,CustomDocumentProperties)
・配列の概念 ・静的配列 ・動的配列 ・セル範囲⇔配列の基本 ・配列で必要となるVBA関数とステートメント ・配列に関する記事の一覧

上のVBAでは、ValueとNumberFormatLocalだけを扱っています。
罫線はプロパティが多くなるので大変ですが、必要なら適宜追加してください。
さすがに、条件付き書式や入力規則まで含めるとかなり難しくなってきます。
もっとも、結合解除した時に条件付き書式や入力規則をどうするかは色々と考えないといけない問題です。

また、結合解除した時に、先頭セルと同じ状態にしたい場合もあると思います。
そのような場合は、「RestoreRange」にオプション引数を追加するなりして、
aRange.Item(1)の情報を使うようにすれば良いでしょう。

セル結合/解除でセル値を退避/回復のVBAの使い方

Sub セル結合する()
  Call MergeRange(Range("D2:D4"))
End Sub

Sub セル結合を解除()
  Call UnMergeRange(Range("D2"))
End Sub

使い方は簡単なので問題はないでしょう。
登録されたCustomDocumentPropertiesの全削除や一覧は、この下に掲載しています。

退避したセル値の全削除と一覧出力

上のVBAでCustomDocumentPropertiesに退避した情報を全クリアしたい場合や、
CustomDocumentPropertiesの一覧を取得したい場合に使ってください。

Sub 使い方サンプル()
  Call CustomDocumentProperties2Sheet(ActiveWorkbook, ActiveSheet)
  Call AllDelCustomDocumentProperties(ActiveWorkbook)
End Sub

'CustomDocumentPropertiesを全削除
Sub AllDelCustomDocumentProperties(ByVal wb As Workbook)
  Dim dp As DocumentProperty
  For Each dp In wb.CustomDocumentProperties
    dp.Delete
  Next
End Sub

'CustomDocumentPropertiesの一覧をシート出力
Sub CustomDocumentProperties2Sheet(ByVal wb As Workbook, _
                  ByVal ws As Worksheet)
  Dim dps As DocumentProperties
  Dim dp As DocumentProperty
  Dim i As Long
  
  'Valueが定義エラーの場合の対応
  On Error Resume Next
  With ws
    .Cells.Clear
    .Range("A1") = "インデックス"
    .Range("B1") = "プロパティ名"
    .Range("C1") = "型"
    .Range("D1") = "値"
    i = 1
    Set dps = wb.CustomDocumentProperties
    For Each dp In dps
      .Cells(i + 1, 1) = i
      .Cells(i + 1, 2).Value = dp.Name
      .Cells(i + 1, 3).Value = dp.Type
      .Cells(i + 1, 4).Value = dp.Value
      i = i + 1
    Next
  End With
End Sub

一覧のシート出力では、シート全体をクリアしているので注意下ください。

セル結合/解除の最後に

セル結合は、確かに弊害が多くできれば使わない方が良いでしょう。
とはいえ、VBAを書く人の多くが他人の要望を受けて作成している場合は多いでしょう。
そんな時、どうしても断れずにセル結合せざる負えなくなってしまったときに、こんな方法もあるのだという事を思い出してもらえれば良いと思います。
ただし、セル結合せずに済むならそれが一番良い事は言うまでもありませんので、セル結合しないように良く話をしてみましょう。



同じテーマ「マクロVBAサンプル集」の記事

シートを名前順に並べ替える
数式内の不要なシート名を削除する(HasFormula)
数式の参照しているセルを取得する
増殖した条件付き書式を整理統合する
条件付き書式で変更された書式を取得する
セル結合/解除でセル値を退避/回復
セル結合なんて絶対に許さないんだからね
セルの数式をネスト色分けしてコメント表示
セル結合して表を見やすくする(非推奨)
シートを削除:不定数のシート名に対応
セル番地でバラバラに指定されたセルの削除


新着記事NEW ・・・新着記事一覧を見る

ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.RangeとCellsの使い方|VBA入門
4.ひらがな⇔カタカナの変換|エクセル基本操作
5.繰り返し処理(For Next)|VBA入門
6.変数宣言のDimとデータ型|VBA入門
7.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
8.並べ替え(Sort)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.Findメソッド(Find,FindNext,FindPrevious)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。


このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ