t-hom’s diary

主にVBAネタを扱っているブログです。

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

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

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

さて、まずは同じように部屋の表を用意。
f:id:t-hom:20180216232720p:plain

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

Function GetRooms(roomRange As Range) As Collection
    Dim ret As Collection: Set ret = New Collection
    Dim rooms: rooms = roomRange.Value
    
    Dim noRoom As Boolean, i As Long
    Do
        noRoom = True
        For i = LBound(rooms, 1) To UBound(rooms, 1)
            If rooms(i, 2) > 0 Then
                ret.Add rooms(i, 1)
                rooms(i, 2) = rooms(i, 2) - 1
                noRoom = False
            End If
        Next
    Loop Until noRoom
    Set GetRooms = ret
End Function

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

Sub Main()
    Const 人数 = 8
    Dim rooms As Collection
    Set rooms = GetRooms(Range("A2:B7"))
    
    If 人数 > rooms.Count Then
        MsgBox "部屋が足りません。", vbExclamation
    Else
        Dim i As Long
        For i = 1 To 人数
            Debug.Print i; "人目は"; rooms(1); "号室です。"
            rooms.Remove 1
        Next
    End If
End Sub

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

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

発展

ここから先は私は作らないので妄想だけど、たとえばこんなふうに部屋代と予約状況が表示されてて、
f:id:t-hom:20180216234804p:plain

その範囲(Range)と、人数を渡すと自動的に再安値で必要な部屋数を確保してくれる関数とかも面白そうだ。

あとはランダムで部屋割りするマクロとか。
これは以下で紹介したShuffleCollectionプロシージャを使えば簡単にできる。
thom.hateblo.jp

以上

当ブログは、amazon.co.jpを宣伝しリンクすることによってサイトが紹介料を獲得できる手段を提供することを目的に設定されたアフィリエイト宣伝プログラムである、 Amazonアソシエイト・プログラムの参加者です。