Collectionクラスの使い方の勉強
人のコードを解読する
（私が勝手に認定した）VBA四天王の１人（あと３人って誰だよｗ）thom (id:t-hom) さんが
コチラの記事でお書きになっているコード
を徹底解剖（笑）する。
参考コード
参考リスト１
Function GetRooms(roomRange As Range) As Collection Dim ret As Collection '……(1)' Set ret = New Collection Dim rooms As Variant '……(2)' rooms = roomRange.Value Dim noRoom As Boolean Dim i As Long Do '……(3)' noRoom = True For i = LBound(rooms, 1) To UBound(rooms, 1) '……(4)' If rooms(i, 2) > 0 Then '……(5)' ret.Add rooms(i, 1) '……(6)' rooms(i, 2) = rooms(i, 2) - 1 '……(7)' noRoom = False '……(8)' End If Next Loop Until noRoom Set GetRooms = ret '……(9)' End Function参考リスト２
Sub Main() Const 人数 = 14 Dim rooms As Collection Set rooms = GetRooms(Range("A2:B7")) '……(10)' If 人数 > rooms.Count Then '……(11)' MsgBox "部屋が足りません。", vbExclamation Else Dim i As Long For i = 1 To 人数 '……(12)' Debug.Print i; "人目は"; rooms(1); "号室です。" '……(13)' rooms.Remove 1 Next End If End Sub※一部コードを変えています。
まずは、参考リスト１から。
(1)からの２行
Dim ret As Collection Set ret = New Collection
Collectionクラスのインスタンス用の変数retを用意して、Newでインスタンスをぶち込んでいる。
この先、retは、何らかのCollectionオブジェクト、ということになる。
(2)からの２行
Dim rooms As Variant rooms = roomRange.Value
は、おなじみ、表を２次元配列にぶち込むアレ。
変数roomsには、後ほど、部屋定員表（Range("A2:B7")）がぶち込まれ、２次元配列になることとなる。
んで、(3)からの10行
Do noRoom = True 【Forループの処理】 Loop Until noRoom
では、Doループの先頭で変数noRoomをTrueにしておき、ブロック内での処理（Forループの処理）が終わってもなおnoRoomがTrueだった場合にDoループを抜けるようになっている。
で、(4)からの７行
For i = LBound(rooms, 1) To UBound(rooms, 1) If rooms(i, 2) > 0 Then '……(5)' ret.Add rooms(i, 1) '……(6)' rooms(i, 2) = rooms(i, 2) - 1 '……(7)' noRoom = False '……(8)' End If Next
が参考リスト１の目玉とも言うべき処理。
変数roomsには、部屋定員表がぶち込まれているので、
LBound(rooms, 1)
および、
UBound(rooms, 1)
は、roomsの中にぶち込まれたのが
この表のＡ２：Ｂ７のセル範囲だとすると、
LBound(rooms, 1) = 1
UBound(rooms, 1) = 6
ということになる。
ここからはForブロック内部の処理。
まず(5)の
If rooms(i, 2) > 0 Then
で、配列roomsの２次元目の値を評価。「0」よりも大きかったらIfブロック内部に進む。要するに、部屋に定員があれば、Ifブロック内に進むということ。
Ifブロック内部に進むと、(6)の
ret.Add rooms(i, 1)
で、配列roomsの１時限目の値、すなわち室名をCollectionクラスのインスタンスretにAddする。
i が「1」のとき、すなわちForループの１回目だと、ret(1)の中身は「201」が入っていることになる。
んで、ここからが面白いところ。
無事に室名「201」がretに格納されたところで、(7)の
rooms(i, 2) = rooms(i, 2) - 1
が実行されるのである。
コレ、すっげー賢いやり方だと思いましたよ！ マジで！ やっぱり四天王すげーですよ。
Forループの１回目でretに「201」が格納された直後の「rooms(1, 2)」の値は、当然「2」。んで、(7)の
rooms(i, 2) = rooms(i, 2) - 1
が実行されると、「rooms(1, 2)」の値が「1減る」んですよ。
あたかも部屋の定員が１つ減ったかのごとく！
よくこんなこと考えつくなー。達人への道は遠い……orz
んで、(8)の
noRoom = False
でnoRoomがFalseになる。
Forループ内で１度でもIfブロック内の処理が行われれば、noRoomはFalseなので、部屋の定員数が尽きるまでDoループを繰り返して、retに室名が追加されていく、という仕組み。
ホント、よくこんなこと思いつくなあ……。
ちょっと分かりにくいかも知れないので、各変数の状態を表にまとめておく。
| Doループ | i | rooms(i, 2)の値 ret追加前 |
retの値 | rooms(i, 2)の値 ret追加後 |
|---|---|---|---|---|
| 1 | 1 | 2 | ret(1)="201" | 1 |
| 1 | 2 | 3 | ret(2)="202" | 2 |
| 1 | 3 | 2 | ret(3)="203" | 1 |
| 1 | 4 | 3 | ret(4)="301" | 2 |
| 1 | 5 | 2 | ret(5)="302" | 1 |
| 1 | 6 | 2 | ret(6)="303" | 1 |
| 2 | 1 | 1 | ret(7)="201" | 0 |
| 2 | 2 | 2 | ret(8)="202" | 1 |
| 2 | 3 | 1 | ret(9)="203" | 0 |
| 2 | 4 | 2 | ret(10)="301" | 1 |
| 2 | 5 | 1 | ret(11)="302" | 0 |
| 2 | 6 | 1 | ret(12)="303" | 0 |
| 3 | 1 | 1 | ret(13)="202" | 0 |
| 3 | 2 | 1 | ret(14)="301" | 0 |
さて、ここからは実行用のMainプロシージャ。
(10)の
Set rooms = GetRooms(Range("A2:B7"))
では、さきほどのGetRoomsに引数としてＡ２：Ｂ７のセル範囲を渡して返り値をぶち込んでいる。
roomsには、定員数分（この場合は14個）の部屋番号がぶち込まれていることになる。
(11)からの９行
If 人数 > rooms.Count Then MsgBox "部屋が足りません。", vbExclamation Else Dim i As Long For i = 1 To 人数 '……(12)' Debug.Print i; "人目は"; rooms(1); "号室です。" '……(13)' rooms.Remove 1 Next End If
では、まず最初にroomsの要素数と人数とを比較している。roomsの要素数は、部屋の総定員なので、人数の方がroomsの要素数よりも多かったら、定員オーバーなのでメッセージを表示して、そのまま終了。
定員内であれば、Elseブロック内に処理が進む。
(12)からの４行
For i = 1 To 人数 Debug.Print i; "人目は"; rooms(1); "号室です。" '……(13)' rooms.Remove 1 Next
では、Forループで１人目から人数分（この場合は14人目まで）ループする。
ループ内部では、まず(13)の
Debug.Print i; "人目は"; rooms(1); "号室です。"
でroomsの先頭の要素（１ループ目だと「201」が入っている）を用いて室名をイミディエイトに表示し、その後すかさず
rooms.Remove 1
で先頭の要素を削除！
こうすることで、次の「202」が先頭の要素になるので、２ループ目（２人目）の部屋番号は「202」が表示される、という仕掛けだ。
これまた、賢いなあ。
実行してみる
この状態で実行。
イミディエイトにこんなふうに表示された。
ちなみに、次のコードで実行すると、
リスト１ 標準モジュール
Sub Main() Const 人数 = 14 Dim rooms As Collection Set rooms = GetRooms(Range("A2:B7")) If 人数 > rooms.Count Then MsgBox "部屋が足りません。", vbExclamation Else Dim i As Long Dim r As Range Set r = Range("D2:D15") For i = 1 To 人数 Debug.Print r.Cells(i, 1).Value; "の部屋は"; rooms(1); "号室です。" rooms.Remove 1 Next End If End Sub
ちょっと豪華になりますｗ
おわりに
今までCollectionって自分で作ったことがなかったけれど、いろいろ面白い使い方がありそうだ。
