部屋割りマクロ(Excel) - 素人がExcelVBAによる「一人働き方改革」に挑むブログ

部屋割りをサクッと済ませるマクロ

部屋割りマクロ

部屋の定員数に応じて、部屋割りをサクッとやってくれるマクロを作ってみた。

同じ定員数の部屋ばっかりだと、単純にmod演算子を使ったループで一発なんだけれど、定員数に凸凹があるときに、定員数順に前もってソートしておくとか、メンドウなので、定員数に凸凹があっても対応できるように考えてみた。

部屋割りマクロのコード

リスト１　標準モジュール

Public Function assignOfRooms(ByVal targetRange As Range, _
                              ByVal roomData As Range, _
                              Optional ByVal hasHeader As Boolean = True) As Boolean
On Error GoTo errorHandler
  '２列以上選択していたらFalseを返す。'
  If targetRange.Columns.Count <> 1 Then
    assignOfRooms = False
    Exit Function
  End If
  '部屋定員表が２列の表でなかったらFalseを返す。'
  If roomData.Columns.Count <> 2 Then
    assignOfRooms = False
    Exit Function
  End If
  '部屋定員表の項目ラベルがあるときは、項目ラベルを表から除く。'
  With roomData
    If hasHeader Then Set roomData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
  End With
  '部屋定員表を２次元配列化する。'
  Dim roomDataArray As Variant
  roomDataArray = roomData.Value  '配列添字が1始まりになるので注意！'
  Dim rowCount As Integer
  rowCount = UBound(roomDataArray, 1)
  '振り番対象のセルの数が、収容人数オーバーだったらFalseを返す。'
  Dim capacityOfAllRooms As Integer
  Dim i As Integer
  For i = 1 To rowCount
    capacityOfAllRooms = capacityOfAllRooms + roomDataArray(i, 2)
  Next
  If capacityOfAllRooms < targetRange.Count Then
    assignOfRooms = False
    Exit Function
  End If
  targetRange.ClearContents
  '振り番処理'
  Dim getFromArrayCount As Integer  '配列にアクセスした回数を記録する変数'
  getFromArrayCount = 1
  Dim loopOfArray As Integer
  For i = 1 To targetRange.Count
    '配列からの値取得が何周目かを計算する。'
    loopOfArray = (getFromArrayCount - 1) \ rowCount + 1
    With targetRange.Cells(i, 1)
      If loopOfArray > roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 2) Then
        '振り番しようとする部屋が定員に達していたら次の部屋に進める'
        Do
          getFromArrayCount = getFromArrayCount + 1
          loopOfArray = (getFromArrayCount - 1) \ rowCount + 1
        Loop Until loopOfArray <= roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 2)
      End If
      .Value = roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 1)
      getFromArrayCount = getFromArrayCount + 1
    End With
  Next
  assignOfRooms = True
  Exit Function
errorHandler:
  assignOfRooms = False
End Function

コードの解説は、いづれ改めて書きます。ひとまず、コード中のコメントでご容赦を。

第１引数で、振り番したいセル範囲を、

第２引数で、部屋の定員表を表す n 行２列のセル範囲を受け取る。

省略可能な第３引数は、部屋の定員表のセル範囲が、項目ラベルを含んでいるかどうかを表す。

部屋割りが成功したらTrue、失敗したらFalseを返すFunctionにしている。

失敗にもいろいろなパターンがあるので、クラスモジュールにした方がいいかも知れない。

実験

シート上に、

f:id:akashi_keirin:20180216090336j:plain

こんなふうにデータを用意し、次のコードで実験してみた。

リスト２　標準モジュール

Public Sub testassignOfRooms()
  If assignOfRooms(targetRange:=Selection, _
                   roomData:=ActiveSheet.Range("A1").CurrentRegion, _
                   hasHeader:=True) Then
    MsgBox "部屋割り完了！"
  Else
    MsgBox "部屋割り失敗！"
  End If
End Sub

f:id:akashi_keirin:20180216090343j:plain