【VBA】ExcelのUnionで纏められたRangeの Areas.Count と Areas.Item(N)

初めに

以前の記事で、Union メソッドで纏められた Range へのアクセス方法を書きました。
z1000s.hatenablog.com

その中で、

今回の場合、
赤で囲まれた範囲がArea(1)
青で囲まれた範囲がArea(2)
となり、
r.Areas(1).Address(False, False)は
B2:D4
r.Areas(2).Address(False, False)は
F3:G4
が返ります。
Unionで指定した順番に返ってくるようです。（そうでないと困ります。）

と書いたのですが、このようにならない場合があることがわかりました。

Union メソッドで、複数のRange を纏めた時、

項目	値
Areas.Item(N)	指定した個々の Range
Areas.Count	指定した Range の数

となるものと思い込んでいたのですが、そうならない場合があるようです。

また、Union メソッドの実行方法によっては、対象となる範囲が同じでも、Areas.Countや、Areas.Item( N ).Address が変わる場合があることがある事がわかりました。

Union メソッド

まず、改めて Union メソッドについて。
docs.microsoft.com

機能

2 つ以上のセル範囲の集合を返します

構文

expression.Union (Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)

パラメータ

名前	必須/オプション	データ型	説明
Arg1	必須	Range
Arg2	必須	Range
Arg3～Arg30	省略可	Range	範囲を指定する

戻り値

Range

使用例

基本的な使い方は、多分以下の２通りと思われます。

対象となる Range の数が固定の場合は、このような書き方ができます。

    Set r = Union(r1, r2, r3, r4)

一方で、対象となる Range が可変の場合や、ループ処理により纏めたいような場合には、こちらの方法が使いやすいと思います。

    Set r = Union(r1, r2)
    Set r = Union(r, r3)
    Set r = Union(r, r4)

他にも、このような書き方も出来ますが、多分ほとんど使われることはないかと思います。

    Set r = Union(Union(Union(r1, r2), r3), r4)

３番目の書き方は、最初の書き方を冗長にしただけのように見えますが、実はそうではありません。
（この件については、後述）

Areas.Count と Areas.Item(N)

実際に返ってくる値

項目	値
Areas.Item(N)	パラメータで指定した１個以上の Range の纏まり
Areas.Count	１以上 指定した Range の数以下

Areas.Item(N)

コレクションから単一のオブジェクトを返します。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas.item

MSのサイトには、下記のような記述があります。

コレクションから単一のRangeオブジェクトを取得するのにには、 Areas (index) を使用します。_引数 index_には、area インデックス番号を指定します。 インデックス番号は、領域が選択された順序に対応します。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas

基本的には、この通りになるようなのですが、例外があります。

Union メソッドに指定する Range が、以下のような場合、Areas.Item(N) は、複数の Range を纏めた範囲になります。つまり、パラメータで指定された複数の Range が、ひとつの Areas.Item(N) に纏まってしまう場合があります。

「任意の複数の Range の集まりが矩形となる」場合に、
ひとつの Areas.Item(N) として纏まるようです。
その場合、領域が選択された順序と一致しない場合があります。

Areas.Count

コレクションに含まれるオブジェクトの数を表す長整数型 (Long) の値を返します。

https://docs.microsoft.com/ja-jp/office/vba/api/excel.areas.count

ここで注意すべきは、
”コレクションに含まれるオブジェクトの数”
であって、
”パラメータで渡した（ Range ）オブジェクトの数”
ではないということです。

前述の通り、パラメータで指定した複数の Range が、ひとつの Areas.Item に纏められる場合、Areas.Count は、それに伴い パラメータの Range 数より少なくなることになります。

Range("A1") から Range("A30") までの３０個の Range を Uniono で纏めると

Set r = Union( Range("A1"), Range("A2"), ・・・, Range("A30") )

纏められた Range r は、

Areas.Count	１
Areas.Item(1).Address	A1:A30
Areas.Address	A1:A30

となります。

複数の Range がひとつの Areas.Item( N ) に纏められるケース（具体例）

Union( r1, r2, r3 )

の記述で、纏めてみた結果が下の図です。
下図のA列にアドレス単独で表示されているものは、Union メソッドに渡した Range であり、Union メソッドには、上から順に渡しています。

なお、下図の中の Areas.Address: の後ろに表示されている [ ] で囲まれたそれぞれの部分が Areas.Item( N ) .Address です。

隣接する２個以上の Range が矩形となる場合

Unionに指定するRangeの順番の影響は見られません。

２個以上の Range の一部が重なるが、全体が矩形となる場合

重なっている部分を含め、全体がひとつのAreas.Item( N ) となります。

Range A に、Range B が含まれる場合

サイズが、基準となる（大きい方の）Range以下の Range は無視されています。

対象範囲が同じでも結果が変わる例

記述の違い（実行方法の違い）によるもの

前述の通り、Union メソッドの書き方は、思いついただけで３パターンあります。

同じ Range を、同じ順番でメソッドに渡しても、返ってくる結果が異なる場合を見つけました。

Range r1、r2、r3 を以下の範囲とします。

変数	Range
r1	Range("D4:E5")
r2	Range("D2:E3")
r3	Range("B2:C3")

これらの範囲を使用して、以下の式が返す結果を比較してみます。

No.	式
1	Set r = Union(r1, r2, r3)
2	Set r = Union(r1, r2) Set r = Union(r, r3)
3	Set r = Union(Union(r1, r2), r3)

No.1 のみが、他と結果が異なっているのがわかります。
No.1 が、r2 と r3 が纏まっているのに対し、
No.2とNo.3は、r1 と r2 が纏まっています。

No.	式	Areas .Count	Areas .Item(1) .Address	Areas .Item(2) .Address
1	Set r = Union(r1, r2, r3)	2	D4:E5	B2:E3
2	Set r = Union(r1, r2) Set r = Union(r, r3)	2	D2:E5	B2:C3
3	Set r = Union(Union(r1, r2), r3)	2	D2:E5	B2:C3

No.1 Union( r1, r2, r3 )

No.2 Union( r1, r2 ) + Union( r, r3 )

No.3 Union( Union( r1, r2 ), r3 )

No.2、No.3では、順次Unionメソッドで Range を纏めているため、その都度 Areas.Item( N ) が更新されていくため、このような結果になると考えられます。

Union メソッドに渡すパラメータの順番による違い

変数	Range
r1	Range("B2:C3")
r2	Range("D2:E3")
r3	Range("B4:C5")

として、
Union( Arg1, Arg2, Arg3 ) と呼び出してみました。

No.	Arg1	Arg2	Arg3
1	r1	r2	r3
2	r3	r2	r1

No.1 Union( r1, r2, r3 )

Union( r3, r2, r1 )

No.1 では、縦方向に纏まっていますが、
No. 2 では、横方向に纏まっています。

コード（抜粋）

コードが欲しい方は、コードをダブルクリックすると、少しだけいいことがあるかもしれません

データ設定、描画処理呼び出し

▼ データ設定、描画処理呼び出しコード

Public Sub showRanges()

    Dim r() As Range

    Sheet1.Activate

    Call ClearAll

    ReDim r(2)
    Set r(0) = Range("B2:C4")
    Set r(1) = Range("D2:E4")
    Set r(2) = Range("F2:G4")
    Call showRangeLoop(r, Range("A2"))
    Call showRangeOnece(r, Range("A2"))

    ReDim r(2)
    Set r(0) = Range("B8:C10")
    Set r(1) = Range("F8:G10")
    Set r(2) = Range("D8:E10")
    Call showRangeLoop(r, Range("A8"))
    Call showRangeOnece(r, Range("A8"))

    ReDim r(2)
    Set r(0) = Range("D14:E16")
    Set r(1) = Range("B14:C16")
    Set r(2) = Range("F14:G16")
    Call showRangeLoop(r, Range("A14"))
    Call showRangeOnece(r, Range("A14"))

    ReDim r(2)
    Set r(0) = Range("B20:D22")
    Set r(1) = Range("E20:G20")
    Set r(2) = Range("E21:G22")
    Call showRangeLoop(r, Range("A20"))
    Call showRangeOnece(r, Range("A20"))

    ReDim r(1)
    Set r(0) = Range("B26:E28")
    Set r(1) = Range("D26:G28")
    Call showRangeLoop(r, Range("A26"))
    Call showRangeOnece(r, Range("A26"))

    ReDim r(1)
    Set r(0) = Range("B31:G33")
    Set r(1) = Range("B31:G33")
    Call showRangeLoop(r, Range("A31"))
    Call showRangeOnece(r, Range("A31"))

    ReDim r(1)
    Set r(0) = Range("B36:G38")
    Set r(1) = Range("D37:E37")
    Call showRangeLoop(r, Range("A36"))
    Call showRangeOnece(r, Range("A36"))

    ReDim r(2)
    Set r(0) = Range("B41:E42")
    Set r(1) = Range("E41:G42")
    Set r(2) = Range("F41:G43")
    Call showRangeLoop(r, Range("A41"))
    Call showRangeOnece(r, Range("A41"))

    ReDim r(2)
    Set r(0) = Range("B47:E48")
    Set r(1) = Range("F47:G48")
    Set r(2) = Range("F47:G49")
    Call showRangeLoop(r, Range("A47"))
    Call showRangeOnece(r, Range("A47"))

    ReDim r(2)
    Set r(0) = Range("F53:G54")
    Set r(1) = Range("F53:G55")
    Set r(2) = Range("B53:E54")
    Call showRangeLoop(r, Range("A53"))
    Call showRangeOnece(r, Range("A53"))

    ReDim r(2)
    Set r(0) = Range("B59:D60")
    Set r(1) = Range("D60:E61")
    Set r(2) = Range("E59:G60")
    Call showRangeLoop(r, Range("A59"))
    Call showRangeOnece(r, Range("A59"))

    ReDim r(2)
    Set r(0) = Range("B65:D66")
    Set r(1) = Range("E65:G66")
    Set r(2) = Range("E67:G67")
    Call showRangeLoop(r, Range("A65"))
    Call showRangeOnece(r, Range("A65"))

    ReDim r(2)
    Set r(0) = Range("E71:G72")
    Set r(1) = Range("B71:D72")
    Set r(2) = Range("E73:G73")
    Call showRangeLoop(r, Range("A71"))
    Call showRangeOnece(r, Range("A71"))

    ReDim r(2)
    Set r(0) = Range("E79:G79")
    Set r(1) = Range("B77:D78")
    Set r(2) = Range("E77:G78")
    Call showRangeLoop(r, Range("A77"))
    Call showRangeOnece(r, Range("A77"))

    ReDim r(2)
    Set r(0) = Range("B83:D84")
    Set r(1) = Range("E85:G85")
    Set r(2) = Range("E83:G84")
    Call showRangeLoop(r, Range("A83"))
    Call showRangeOnece(r, Range("A83"))

    ReDim r(2)
    Set r(0) = Range("E89:G90")
    Set r(1) = Range("E91:G91")
    Set r(2) = Range("B89:D90")
    Call showRangeLoop(r, Range("A89"))
    Call showRangeOnece(r, Range("A89"))

    ReDim r(2)
    Set r(0) = Range("E97:G97")
    Set r(1) = Range("E95:G96")
    Set r(2) = Range("B95:D96")
    Call showRangeLoop(r, Range("A95"))
    Call showRangeOnece(r, Range("A95"))

End Sub

描画処理

▼ 描画処理コード

'各Range 塗りつぶし他
Public Sub showRangeLoop(ByRef r() As Range, ByRef rMemoRange As Range)

    Const OFFSET_C  As Long = 8

    Dim rW()        As Range
    Dim rMemoRangeW As Range
    Dim rUnion      As Range
    Dim sAddress    As String
    Dim lColors(3)  As Long
    Dim i           As Long
    Dim j           As Long

    If UBound(r) > UBound(lColors) Then
        Err.Raise ERROR_INVALID_INDEX, "showRangeLoop", "range elements to big."

        Exit Sub
    End If

    ReDim rW(UBound(r))
    For i = 0 To UBound(r)
        Set rW(i) = r(i).Offset(0, OFFSET_C)
    Next i

    Set rMemoRangeW = rMemoRange.Offset(0, OFFSET_C)

    lColors(0) = vbMagenta
    lColors(1) = vbGreen
    lColors(2) = RGB(&HFF, &HA5, 0)
    lColors(3) = RGB(0, &HA5, &HFF)

    For i = 0 To UBound(rW)
        'Rangeアドレス記入
        With rMemoRangeW.Offset(i)
            .Value = rW(i).Address(False, False)
            .Font.Color = lColors(i)
        End With

        'Range塗りつぶし
        With rW(i).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlColorIndexNone
            .Color = lColors(i)
        End With

        If i = 0 Then
            Set rUnion = rW(0)
        Else
            Set rUnion = Union(rUnion, rW(i))
        End If
    Next i

    'Areas.Count記入
    rMemoRangeW.Offset(i).Value = "Areas.Count:" & rUnion.Areas.Count

    'Areas.Item(N)
    For j = 1 To rUnion.Areas.Count
        '境界線
        Call drawRangeBorder(rUnion.Areas.Item(j), vbBlack)

        'Address
        sAddress = sAddress & "[" & rUnion.Areas.Item(j).Address(False, False) & "]"
    Next j

    'Areas.Address記入
    rMemoRangeW.Offset(i + 1).Value = "Areas.Address:" & sAddress

End Sub

Public Sub showRangeOnece(ByRef r() As Range, ByRef rMemoRange As Range)

    Const OFFSET_C  As Long = 0

    Dim rW()        As Range
    Dim rMemoRangeW As Range
    Dim rUnion      As Range
    Dim sAddress    As String
    Dim lColors(3)  As Long
    Dim i           As Long
    Dim j           As Long

    If UBound(r) > UBound(lColors) Then
        Err.Raise ERROR_INVALID_INDEX, "showRangeOnece", "range elements to big."

        Exit Sub
    End If

    ReDim rW(UBound(r))
    For i = 0 To UBound(r)
        Set rW(i) = r(i).Offset(0, OFFSET_C)
    Next i

    Set rMemoRangeW = rMemoRange.Offset(0, OFFSET_C)

    lColors(0) = vbMagenta
    lColors(1) = vbGreen
    lColors(2) = RGB(&HFF, &HA5, 0)
    lColors(3) = RGB(0, &HA5, &HFF)

    For i = 0 To UBound(r)
        'Rangeアドレス記入
        With rMemoRangeW.Offset(i)
            .Value = rW(i).Address(False, False)
            .Font.Color = lColors(i)
        End With

        With rW(i).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlColorIndexNone
            .Color = lColors(i)
        End With
    Next i

    Select Case UBound(r)
    Case 1
        Set rUnion = Union(rW(0), rW(1))
    Case 2
        Set rUnion = Union(rW(0), rW(1), rW(2))
    Case 3
        Set rUnion = Union(rW(0), rW(1), rW(2), rW(3))
    End Select

    'Areas.Count記入
    rMemoRangeW.Offset(i).Value = "Areas.Count:" & rUnion.Areas.Count

    'Areas.Item(N)
    For j = 1 To rUnion.Areas.Count
        '境界線
        Call drawRangeBorder(rUnion.Areas.Item(j), vbBlack)

        'Address
        sAddress = sAddress & "[" & rUnion.Areas.Item(j).Address(False, False) & "]"
    Next j

    'Areas.Address記入
    rMemoRangeW.Offset(i + 1).Value = "Areas.Address:" & sAddress

End Sub

'Area境界線描画
Public Sub drawRangeBorder(ByRef targetRange As Range, ByVal lColor As Long)

    Dim sgLeft      As Single
    Dim sgTop       As Single
    Dim sgWidth     As Single
    Dim sgHeight    As Single

    sgLeft = targetRange.Left
    sgTop = targetRange.Top
    sgWidth = targetRange.Width
    sgHeight = targetRange.Height

    With ActiveSheet.Shapes.AddShape(msoShapeRectangle, sgLeft, sgTop, sgWidth, sgHeight)
        .Fill.Visible = msoFalse
        .ThreeD.Visible = msoFalse
        With .Line
            .Visible = msoTrue
            .Weight = 2.25
            .ForeColor.RGB = lColor
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = 0
            .DashStyle = msoLineDash
            .Transparency = 0
        End With
    End With

End Sub

その他

▼ その他コード

Public Sub ClearAll()

    ActiveSheet.Cells.Clear

    Call removeAllShapes

End Sub

Public Sub removeAllShapes()

    Dim shp As Shape

    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next

End Sub

最後に

処理方法によって結果が変わる場合があるのは分かった。
キーワードは、矩形

しかし、Union( r1, r2, ・・・, rn ) の場合の規則性が分からん。

Areas.Item( N ).Address が変わって困るような処理は今の所ないから、
今回はここまでで勘弁してやろう・・・ orz

m(_ _)m