セルの結合・解除

中級VBA

結合されたセルへの代入と参照

 セルを結合した場合、値の代入と参照は、左上隅の(先頭)セルを使うことになります。
 ほかの部分に値を代入しても、エラーとはなりませんが値を参照することはできません。

Sub TestMerge01()
    'A1:B2の4つのセルが結合されている時
    Range("B2") = 11
    Debug.Print Range("B2") '何も表示されない
End Sub

 これがセル結合でのExcelの仕様となります

セルの結合と解除 2つの方法

 セルの結合と解除を行うにはRangeオブジェクトのメソッドを使う方法とプロパティを使う2つの方法があります。

  • Mergeメソッド / UnMergeメソッド
  • MergeCellsプロパティ

Mergeメソッド / UnMergeメソッド

 Mergeメソッドでは、引数にTrueを指定すると行ごとに結合します。
 引数を指定しないか、Falseを指定した場合は、すべてのセルを結合します。

Sub TestMerge02()
    Range("A3:B5").Merge True '行ごとに結合
    Range("A6:B8").Merge      'すべて結合
End Sub

 UnMergeメソッドは結合を解除します。解除に指定するセルは結合された領域内であればどこでもOKです。
 結合セルの一部分のみ解除することはできません。

Sub TestMerge03()
    Range("A4").UnMerge    'セルの結合を解除
End Sub

MergeCellsプロパティ

 MergeCellsプロパティTrueをセットする事でセルを結合します。
 Falseを設定すれば解除できます。解除の場合は領域内のどこでもOKです。
 MergeCellsプロパティでは、Mergeメソッドのように行ごとに結合するような機能はありません。

Sub TestMerge04()
    Range("A3:B5").MergeCells = True  'すべて結合
    Range("A4").MergeCells = False    '解除
End Sub

既に値がある場合への対処

 セルの結合に関しては、領域内に既に値があった場合、その値が削除されてしまう時に確認メッセージが出ます。

 この確認メッセージで「キャンセル」を選択すると、結合が行われないため実行時エラーが発生してしまいます。

 この時、キャンセルを選択しても、実行時エラーを出さないようにするには、
On Error Resume Next を使用します。
 こうする事でキャンセルを選択した場合、Mergeは実行されない形になります。

Sub TestMerge05()
    On Error Resume Next
    Range("A6:B8").Merge
End Sub

 また、警告そのものを出したくない場合は、DisplayAlertsでメッセージを出ないようにする事ができます。
 この場合は、右上隅のセル(先頭セル)以外の値は強制的に削除されることになります。

Sub TestMerge06()
   Application.DisplayAlerts = False
   Range("A6:B8").Merge
   Application.DisplayAlerts = True
End Sub

 領域のセルに値が無ければ、これらの対処は必要ありませんので、視点を変えて領域の値をクリアしておくという方法も考えられます。

Sub TestMerge07()
    Range("A6:B8").Clear
    Range("A6:B8").Merge
End Sub

セルが結合されているか調べる

 あるセルが結合されているか調べるには、MergeCellsプロパティで判断することができます。

Sub TestMerge08()
    If Range("A7").MergeCells Then
        Debug.Print "セルが結合されています"
    Else
        Debug.Print "セルが結合されていません"
    End If
End Sub

あるセルの結合領域を得る

 結合領域をRangeで得たい場合は、MergeAreaを使います。
 以下のサンプルでは、MergeAreaを使ってRange型で受けています。

Sub TestMerge09()
    Dim r As Range
    Set r = Range("A7").MergeArea
    Debug.Print r.Address
End Sub
タイトルとURLをコピーしました