複数のセル範囲をひとつのRangeにする - Union

複数のセル範囲をひとつのRangeオブジェクトに統合する、
Unionメソッドについて解説します。

基本構文

統合セル範囲 = Union(セル範囲1, セル範囲2, …)

サンプルコード

Dim 統合セル範囲 As Range

Set 統合セル範囲 = Union(Range("A1"), Range("B2"))
MsgBox 統合セル範囲.Address(0, 0) ' A1,B2 (カンマ区切りで統合)

Set 統合セル範囲 = Union(Range("A1:A3"), Range("B1:B3"))
MsgBox 統合セル範囲.Address(0, 0) ' A1:B3 (ちょうど矩形になるならセル範囲に統合)

解説

Unionメソッドは任意の数のRangeオブジェクトを受け取って、
それをすべて統合した一つのRangeオブジェクトを返すメソッドです。

A1セルとB2セルを渡すと「A1,B2」になっているように、
Ctrlキーを押しながら複数セルを選択しているイメージですね。

ただしCtrlキーと違うのが「矩形(長方形)が完成する場合はエリアも統合する」点で、
上記のサンプルの通り、A1:A3とB1:B3を合わせるとA1:B3にしてくれます。

矩形として合体されたのかどうか、結果何エリアになったのかどうかは、
Areasプロパティを使用して判定してください。

Set 統合セル範囲 = Union(Range("A1:A3"), Range("B1:B3"))
MsgBox 統合セル範囲.Areas.Count ' ←矩形にまとまったため「1」が表示

Areasプロパティについての詳細はこちらの記事をどうぞ。
www.limecode.jp

細かな仕様

Unionメソッドの細かい仕様は以下の通りです。

第1Range	第2Range	結果
A1:A3	B1:B3	A1:B3
A1:A3,B1	B2:B3	A1:B3
A1:B3	B1:C3	A1:C3
A1:C3	A1:A3	A1:C3
B1:B3	A2:C2	B1:B3,A2:C2
A1:A3	A1:C1	A1:A3,A1:C1

2つ目のような複雑なRangeに実行しても1つの矩形範囲を作ってくれている通り、
割と柔軟に複数範囲から作れる矩形を探してくれます。

3,4つ目のように重なっている範囲があったとしても、
綺麗な矩形にできるのであれば重複をなくして矩形化してくれていますね。

とはいえ5,6つ目の実行の通り、さすがに交差範囲はそのままカンマで区切ります。

これをFor Eachで回すと交点のB2,A1セルが2回処理される通り、
Unionに渡せば重複がなくなって1セル1個になってくれるわけではない
という点には注意してください。

使用例

UnionはRangeの足し算のようなメソッドですので、
普通の変数でよくやる

売上 = 売上 + Cells(R, C)
文字列 = 文字列 & Cells(R, C)

といった「X = X + ○」系の処理をRangeで行う際に便利です。

' こんな風にRangeで変数に蓄積していく処理をかける
Rangeを貯める変数 = Union(Rangeを貯める変数, 追加するRange)

　
このコードの活用例として、
「削除する行をまとめてから一括削除するコード」がこちらです。

Dim rows削除行 As Range
Dim R As Long
For R = 2 To 最終行
    
    If ws処理シート.Cells(R, 1) = "○○" Then
        If rows削除行 Is Nothing Then
            Set rows削除行 = ws処理シート.Rows(R)
        Else
            Set rows削除行 = Union(rows削除行, ws処理シート.Rows(R))
        End If
    End If
    
Next

If Not rows削除行 Is Nothing Then
    rows削除行.Delete
End If

Unionを使ったループ処理の参考にしてください。

UnionはNotiongを受け取れない

Unionメソッドには「Notiongを受け取るとエラー」という欠点があります。

UnionメソッドにNothingを渡してしまうと、

実行時エラー '5': プロシージャの呼び出し、または引数が不正です。

エラーとなります。

これは先ほどの

Rangeを貯める変数 = Union(Rangeを貯める変数, 追加するRange)

この処理を行いたいときにも注意が必要で、
Rangeを貯める変数にまだ一つもRangeが入っていないときには実行できません。

よって上記のコードでは以下のとおり対応しています。

' 出来ればこう書きたいが。。。これは初回実行時にエラー
If ws処理シート.Cells(R, 1) = "○○" Then
    Set rows削除行 = Union(rows削除行, ws処理シート.Rows(R))
End If

' こう書かけばエラーは回避
If ws処理シート.Cells(R, 1) = "○○" Then
    If rows削除行 Is Nothing Then
        Set rows削除行 = ws処理シート.Rows(R)
    Else
        Set rows削除行 = Union(rows削除行, ws処理シート.Rows(R))
    End If
End If

この仕様には十分注意してください。

しかしこの仕様、正直言って対応が面倒です。

しかもUnionを使用するマクロは複雑なことも多く、
そんなコードで簡単な分岐に5行も使うと読みづらくなりますし。

そこで、この仕様への対応を関数化してしまい、
以下のように記載する方法もあります。

' Union改
Function Union改(Arg1 As Range, Arg2 As Range) As Range
    If Arg1 Is Nothing Then
        Set Union改 = Arg2
    ElseIf Arg2 Is Nothing Then
        Set Union改 = Arg1
    Else
        Set Union改 = Union(Arg1, Arg2)
    End If
End Function

' 先ほどのコードがこちらに
Dim rows削除行 As Range
Dim R As Long
For R = 2 To 最終行
    
    If ws処理シート.Cells(R, 1) = "○○" Then
        Set rows削除行 = Union改(rows削除行, ws処理シート.Rows(R))
    End If
    
Next

If Not rows削除行 Is Nothing Then
    rows削除行.Delete
End If

　
Unionを多用する方は、こちらの汎用関数の採用をご検討ください。