セルを結合するにはRangeオブジェクトのMergeメソッドを実行します。
Sub Sample1() Range("A1:B3").Merge End Sub
こんな感じです。実行するとセル範囲A1:B3が結合されます。ちなみに結合を解除するにはUnMergeメソッドを実行します。
さて、セルを結合したり解除したりするのは簡単ですが、任意のセルが結合されているかどうかを調べるにはどうしたらいいでしょう。実は今やってる仕事の支援システムを作っていて、この判断が必要になりました。そんなに難しいテクニックではありませんが、意外と知られていないようなので、せっかくですからご紹介しましょう。
ここでは上図のようなシートを例にします。セル範囲A3:A4とセル範囲A6:A8が結合されています。B列は結合されていません。よくみかけるレイアウトですよね。
結合セルの判定で役立つのはMergeCellsプロパティとMergeAreaプロパティです。MergeCellsは、任意のセルが結合されていたときTrueを返します。
Sub Sample2() Dim i As Long, buf As String For i = 2 To 9 If Cells(i, 1).MergeCells Then buf = buf & Cells(i, 1).Address(0, 0) & "-->結合されています" & vbCrLf Else buf = buf & Cells(i, 1).Address(0, 0) & "-->結合されていません" & vbCrLf End If Next i MsgBox buf End Sub
MergeAreaプロパティは、その結合セルに含まれるセル範囲を返します。たとえば結合セルA6には、セルA6、セルA7、セルA8が含まれますので、MergeAreaプロパティはこの3セルを含むセル範囲(Rangeオブジェクト)を返します。ここで便利なのが、MergeAreaメソッドは結合されていないセルに対しても有効だということです。
Sub Sample3() Dim Target As String, i As Long, buf As String, c Target = InputBox("年度を指定してください") If Target = "" Then Exit Sub For i = 2 To 9 If Left(Cells(i, 1), 4) = Target Then buf = Target & "(" & Cells(i, 1).Address(0, 0) & ")" & vbCrLf buf = buf & "----------" & vbCrLf For Each c In Cells(i, 1).MergeArea buf = buf & c.Address(0, 0) & vbCrLf Next c MsgBox buf Exit For End If Next i End Sub
もちろん結合していないセルを操作してもエラーにはなりません。
MergeAreaメソッドは結合されているセル範囲(Rangeオブジェクト)を返しますので、次のようにして結合されている大きさなどを調べることも可能です。
Sub Sample4() Dim buf As String With Range("A1").MergeArea buf = buf & .Rows.Count & "行" & vbCrLf buf = buf & .Columns.Count & "列" & vbCrLf buf = buf & .Count & "個" & vbCrLf buf = buf & .Item(1).Address(0, 0) & ":左上" & vbCrLf buf = buf & .Item(.Count).Address(0, 0) & ":右下" End With MsgBox buf End Sub
上記のコードでは「Range("A1").MergeArea」をWithステートメントでくくりましたので、左上セルや右下セルを取得するのにItemプロパティを使っています。Itemプロパティは、こんなときに超便利ですね~。もちろん、Range("A1").MergeArea.Item(1)にはRange("A1").MergeArea(1)でもアクセスできます。
以上のことを応用して、指定された年度の受賞者を表示するには次のようなコードになります。
Sub Sample5() Dim Target As String, i As Long, buf As String, c Target = InputBox("年度を指定してください") If Target = "" Then Exit Sub For i = 2 To 9 If Left(Cells(i, 1), 4) = Target Then buf = Target & "年の受賞者は、" & vbCrLf For Each c In Cells(i, 1).MergeArea buf = buf & c.Offset(0, 1) & "さん" & vbCrLf Next c MsgBox buf Exit For End If Next i End Sub
しつこいようですが、結合されていないセルもOKです。