独自のコレクションを作る


重複しないリストを作る(2)」でCollectionを使う方法を書きましたので、本来の「Collectionの使い方」も書いておきましょう。Collectionオブジェクトは、独自のコレクションを作成できる機能です。コレクションといえば、分かりやすいのはSheetsコレクションです。

こうなっていたとき、

【Sheetsコレクション】

オブジェクト インデックス 名前(Name)
Worksheet 1 Sheet1
Worksheet 2 Sheet2
Worksheet 3 Sheet3

ということですよね。

さて、このようにコレクションになっていれば、たとえば「Sheets("Sheet1")」とか「Sheets(2)」のようにして、コレクション内のオブジェクトを指定できます。インデックスを使えば、次のように順番に処理するのも簡単です。

Sub Macro1()
    Dim i As Long
    For i = 1 To Sheets.Count
        ''Sheets(i) に対する処理
    Next i
End Sub

じゃ、次のようになっていたらどうでしょう。

このうち「桜井」「広瀬」「西野」のシートだけを、順番に操作したいんです。実務ではよくある話です。もし、この3つのシートだけが、

オブジェクト インデックス 名前(Name)
Worksheet 1 桜井
Worksheet 2 広瀬
Worksheet 3 西野

というコレクションになっていたら、先のコードと同じように、For Nextで回せますよね。だったら、この3つだけのコレクションを、独自に作ってしまいましょう。そのときに使うのがCollectionです。

Sub Macro1()
    Dim Targets As New Collection, i As Long
    Targets.Add Sheets("桜井"), "桜井"
    Targets.Add Sheets("広瀬"), "広瀬"
    Targets.Add Sheets("西野"), "西野"
    
    For i = 1 To Targets.Count
        ''Targets(i) に対する処理
    Next i
End Sub

もう少し実用的にするなら次のような感じですかね。ここでは「"Sheet"で始まらないシート」だけをコレクション化します。

Sub Macro2()
    Dim Targets As New Collection, i As Long, buf As String
    For i = 1 To Sheets.Count
        If Left(Sheets(i).Name, 5) <> "Sheet" Then
            Targets.Add Sheets(i), Sheets(i).Name
        End If
    Next i
    For i = 1 To Targets.Count
        buf = buf & Targets(i).Name & vbCrLf
    Next i
    MsgBox buf
End Sub

ここで重要なことは、Targetsコレクションの要素はWorksheetオブジェクトだということです。"桜井"とか"広瀬"などの文字列ではありません。オブジェクトです。だから Targets(i).Name のようにNameプロパティを操作できます。このように、オブジェクトの集合体であるコレクションを、独自に作成できるのがCollectionです。

もちろん、コレクションを作れるのはシートだけではありません。Excelのオブジェクトでしたら、何でもいけます。たとえば次のコードは、セルの背景に何らかの色が設定されているセルだけのコレクションを作ります。

Sub Macro3()
    Dim C As Range, Targets As New Collection, i As Long, A As Long
    For Each C In Range("A1").CurrentRegion
        If C.Interior.Color <> RGB(255, 255, 255) Then
            Targets.Add C, C.Address
        End If
    Next C
    For i = 1 To Targets.Count
        A = A + Targets(i).Value
    Next i
End Sub

もちろん、異なるシート内のセル(Rangeオブジェクト)からも、ひとつのコレクションを作れます。Sheet1からSheet3に、次のような表があったとします。

[Sheet1]

[Sheet2]

[Sheet3]

データの数は不定ですが、A列には必ず"合計"というセルがあるとします。この"合計"というセルだけのコレクションを作ってみます。

Sub Macro4()
    Dim FC As Range, Targets As New Collection, buf As String, i As Long
    For i = 1 To Sheets.Count
        Set FC = Sheets(i).Range("A:A").Find("合計")
        Targets.Add FC, FC.Parent.Name
    Next i
    For i = 1 To Targets.Count
        buf = buf & Targets(i).Parent.Name & "!" & Targets(i).Address & vbCrLf
    Next i
    MsgBox buf
    MsgBox Targets("Sheet2").Offset(0, 1)
End Sub

最後にオマケです。オートシェイプでやってみましょう。

この中で、円(Oval)だけのコレクションを作り、上下の間隔を統一します。

Sub Macro5()
    Dim Targets As New Collection, sh As Shape, i As Long
    For Each sh In ActiveSheet.Shapes
        If Left(sh.Name, 4) = "Oval" Then
            Targets.Add sh, sh.Name
        End If
    Next sh
    For i = 2 To Targets.Count
        Targets(i).Top = Targets(i - 1).Top + Targets(i - 1).Height + 20
    Next i
End Sub

めったにやることではありませんが、独自のコレクションを作れると、マクロが劇的に簡素化できるケースもあります。まぁ、覚えておいて損はないです。