VBA 部屋割りマクロ(ネタをいただきました)

いつも読んでるid:akashi_keirinさんのサイトに食指が動くネタがあったので乗っかってみようと思います。
akashi-keirin.hatenablog.com

Twitterで本人にコンタクトして快諾いただきました。

さて、まずは同じように部屋の表を用意。

そして、部屋をコレクションとして取得する関数を作成。
この関数は部屋データの表範囲(今回ならA2:B7)を引き渡して、部屋が入ったコレクションを取得する想定。

Function GetRooms(roomRange As Range)As Collection
    Dim ret As Collection: Set ret =New Collection
    Dim rooms: rooms = roomRange.ValueDim noRoom AsBoolean, i AsLongDo
        noRoom =TrueFor i =LBound(rooms,1)ToUBound(rooms,1)If rooms(i,2)>0Then
                ret.Add rooms(i,1)
                rooms(i,2)= rooms(i,2)-1
                noRoom =FalseEndIfNextLoopUntil noRoom
    Set GetRooms = ret
EndFunction

これを使って部屋を順番に割り当てる処理がこちら。

Sub Main()Const人数 =8Dim rooms As Collection
    Set rooms = GetRooms(Range("A2:B7"))If人数 > rooms.CountThenMsgBox"部屋が足りません。",vbExclamationElseDim i AsLongFor i =1To人数
            Debug.Print i; "人目は"; rooms(1); "号室です。"
            rooms.Remove1NextEndIfEndSub

表への書き出しまで再現するのは面倒だったのでDebug.Printで代用した。

※GetRooms関数とMain関数でそれぞれ変数roomsを用いているが、別物であることに注意。
　Main内のroomsはCollection、GetRooms内のroomsはバリアント型で、中身はセル範囲を転記した配列である。