VBAで結合セルの場所を高速に探す｜ Excel作業をVBAで効率化

結合セルを探すにはRange.MergeCellsプロパティを使う

シートのどこに結合セルがあるのかを探すにはRangeオブジェクトのMergeCellsプロパティを使います。

MergeCellsプロパティの戻り値はVariant型ですが、Trueが返ってきた場合は対象のRangeオブジェクトの範囲に結合セルが含まれていることを示します。

その機能を使って結合セルを探すコードを紹介します。

結合セルを探すコード

処理概要

アクティブシートから結合セルを探す関数です。結合セルがなくても動作します。

結合セルが見つかった場合はそのセル範囲であるAddressプロパティの値を配列に格納しています。

結合セルを探す処理

検索対象範囲は10行目のアクティブシートのUsedRangeプロパティで判定しています。

UsedRangeプロパティはシートで利用されているセル範囲を返すため、シートの全セルをチェックする必要がなくなり、高速に処理することが可能になります。

結合セルを探す処理は前半の12行目です。

ここのMergeCellsプロパティがTrueの場合はそのセル範囲に結合セルが含まれていることを意味します。

「r.MergeArea(1).Address = r.Address」の条件は結合セルのうちの先頭のセルを指しています。

この条件が無ければたとえば３つのセルを結合させている場合に、３つのセルそれぞれでMergeCellsプロパティがTrueに判定されてしまい配列にセル範囲を格納してしまいます。結合セルかどうかは１か所分かればいいためこの条件を入れて結合セルのアドレスが配列に重複して格納されないようにしています。

結合セルが見つかった場合の出力方法

19行目の配列に格納する処理のあとはどのように結合セルの場所を出力するかの処理です。３つの方法で出力しています。

20行目は結合セルのアドレスをイミディエイトウィンドウに出力しています。

31行目からは新規シートを追加してA1セルから下に向かって結合セルのアドレスを出力しています。

42行目からは配列の各要素を改行コードで連結してメッセージボックスに出力しています。

３つの出力方法のうちいらない部分はコメントアウトするなり削除するなりしてください。

Sub SearchMergeCell()
    Dim r           As Range        '// 1セル
    Dim sAddress    As String       '// 結合セル座標範囲
    Dim ar()        As String       '// 結合セル座標格納配列
    Dim i                           '// ループカウンタ
    Dim s                           '// 結合セル座標文字列
    
    ReDim ar(0)
    
    For Each r In ActiveSheet.UsedRange
        '// 結合セルの場合、かつ、結合セルの先頭セルの場合
        If r.MergeCells = True And r.MergeArea(1).Address = r.Address Then
            sAddress = r.MergeArea.Address(False, False)
            
            '// 1. イミディエイトに出力
            Debug.Print sAddress
            
            '// 配列に格納
            ar(UBound(ar)) = sAddress
            ReDim Preserve ar(UBound(ar) + 1)
        End If
    Next
    
    '// 配列に格納済みの場合
    If IsEmpty(ar(0)) = False Then
        '// 余分な領域を削除
        ReDim Preserve ar(UBound(ar) - 1)
    End If
    
    '// 配列に格納済みの場合
    If IsEmpty(ar(0)) = False Then
        '// 2. 別シートを作成して結合セルを出力
        Worksheets.Add
        i = 1
        For Each s In ar
            Cells(i, 1).value = s
            i = i + 1
        Next
    End If
    
    '// 3. メッセージボックスに出力
    s = ""
    For i = 0 To UBound(ar)
        s = s & ar(i) & vbCr
    Next
    Call MsgBox(s)
End Sub

Sub SearchMergeCell()

Dim r As Range '// 1セル

Dim sAddress As String '// 結合セル座標範囲

Dim ar() As String '// 結合セル座標格納配列

Dim i '// ループカウンタ

Dim s '// 結合セル座標文字列

ReDim ar(0)

For Each r In ActiveSheet.UsedRange

'// 結合セルの場合、かつ、結合セルの先頭セルの場合

If r.MergeCells = True And r.MergeArea(1).Address = r.Address Then

sAddress = r.MergeArea.Address(False, False)

'// 1. イミディエイトに出力

Debug.Print sAddress

'// 配列に格納

ar(UBound(ar)) = sAddress

ReDim Preserve ar(UBound(ar) + 1)

End If

'// 配列に格納済みの場合

If IsEmpty(ar(0)) = False Then

'// 余分な領域を削除

ReDim Preserve ar(UBound(ar) - 1)

End If

'// 配列に格納済みの場合

If IsEmpty(ar(0)) = False Then

'// 2. 別シートを作成して結合セルを出力

Worksheets.Add

i = 1

For Each s In ar

Cells(i, 1).value = s

i = i + 1

End If

'// 3. メッセージボックスに出力

s = ""

For i = 0 To UBound(ar)

s = s & ar(i) & vbCr

Call MsgBox(s)

End Sub

使用例

以下のように３つの結合セルがあるシートがあるとします。結合セルは黄色にしています。

あとはこのシートをアクティブにして上のSearchMergeCell関数を実行するだけです。

実行後に以下の３つが出力されます。

イミディエイトウィンドウ

新規追加シート

メッセージボックス

結合セルを探すにはRange.MergeCellsプロパティを使う

結合セルを探すコード

処理概要

結合セルを探す処理

結合セルが見つかった場合の出力方法

使用例

関連記事