部屋割りマクロ(Excel)(2)

部屋割りマクロ

クラスを使ってみる

部屋を表すクラスを作って、部屋の数だけインスタンスを生成し、部屋が人間を取り合うようなイメージでコーディングしてみた。

Roomクラス

クラスモジュールを挿入し、オブジェクト名は「Room」とした。

リスト1 クラスモジュール
Option Explicit

'Member Variable'
Private capacityOf_ As Integer
Private nameOf_ As String
Private isFull_ As Boolean
Private isInitialized_ As Boolean

'Accessor'
Public Property Get capacityOf() As Integer
  capacityOf = capacityOf_
End Property

Public Property Get nameOf() As String
  nameOf = nameOf_
End Property

Public Property Get isFull() As Boolean
  isFull = isFull_
End Property

'Constructor'
Public Sub init(ByVal roomCapacity As Integer, _
                ByVal roomName As String)
  If isInitialized_ Then Exit Sub
  capacityOf_ = roomCapacity
  nameOf_ = roomName
  isInitialized_ = True
End Sub

'Methods'
Public Function allocate() As Boolean
  If capacityOf_ = 0 Then allocate = False: Exit Function
  capacityOf_ = capacityOf_ - 1
  allocate = True
End Function

ひとまず、こんな感じ。非常に単純な作りのクラス。

部屋割り用プロシージャ

akashi-keirin.hatenablog.com

こいつの「振り番処理」の部分を、Roomクラスを用いるコードに置き換える。

メンドクサイので、宣言セクションのところも一緒に載っけておく。

スト2 標準モジュール
Option Explicit

Public Enum AssignRoomsResult
  assignSuccessed = True
  failedByMultipleColumns = 1
  failedByNotTwoColumnsTable
  failedByIrregularRoomDataTable
  failedByOverCapacity
  failedByUnknownReason = 10
End Enum

Public Function allocateRooms(ByVal targetRange As Range, _
                              ByVal roomData As Range, _
                              Optional ByVal hasHeader As Boolean = True) _
                                As AssignRoomsResult
On Error GoTo errorHandler
  'targetRangeが不正ならば終了'
  If Not isAppropriateAsTargetRange(targetRange:=targetRange) Then _
    allocateRooms = failedByMultipleColumns: Exit Function
  '部屋定員表が不正ならば終了'
  If Not isAppropriateAsCapacityTabele(roomData:=roomData) Then _
    allocateRooms = failedByNotTwoColumnsTable: Exit Function
  '部屋定員表の項目ラベルがあるときは、項目ラベルを表から除く'
  With roomData
    If hasHeader Then _
      Set roomData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
  End With
  '部屋定員表を2次元配列化する'
  Dim roomDataArray As Variant
  roomDataArray = roomData.Value
  '部屋定員表が不正な内容ならば終了'
  If Not isAppropriateAsRoomDataTable(roomDataArray:=roomDataArray) Then _
    allocateRooms = failedByIrregularRoomDataTable: Exit Function
  '部屋割り対象人数がキャパオーバーなら終了'
  If isOverCapacity(roomDataArray:=roomDataArray, _
                    targetNumberOfPeople:=targetRange.Count) Then _
    allocateRooms = failedByOverCapacity: Exit Function
  '一旦書き込み先をクリア'
  targetRange.ClearContents
  '振り番処理'
  Dim roomCount As Integer
  roomCount = UBound(roomDataArray, 1)
  Dim rooms() As Room
  ReDim rooms(1 To roomCount)
  Dim i As Integer
  For i = 1 To roomCount
    Set rooms(i) = New Room
    rooms(i).init roomCapacity:=roomDataArray(i, 2), _
                  roomName:=roomDataArray(i, 1)
  Next
  Dim isAllocated As Boolean
  Dim n As Integer
  n = 1
  Dim Sh As Worksheet
  Set Sh = targetRange.Parent
  Do
    For i = 1 To roomCount
      With rooms(i)
        If Not Sh.Rows(targetRange.Cells(n, 1).Row).Hidden Then
          If .allocate Then
            targetRange.Cells(n, 1).Value = .nameOf
            n = n + 1
            If n > targetRange.Count Then Exit For
          End If
        Else
          i = i - 1
          n = n + 1
          If n > targetRange.Count Then Exit For
        End If
      End With
    Next
  Loop Until n > targetRange.Count
  allocateRooms = assignSuccessed
  Exit Function
errorHandler:
  allocateRooms = failedByUnknownReason
  Debug.Print Err.Number & ":" & Err.Description
End Function
'///振り番対象セル範囲が適切かどうか判定するFunction'
Private Function isAppropriateAsTargetRange( _
                   ByVal targetRange As Range) As Boolean
  If targetRange.Columns.Count <> 1 Then
    isAppropriateAsTargetRange = False
  Else
    isAppropriateAsTargetRange = True
  End If
End Function
'///定員表が適切かどうか判定するFunction'
Private Function isAppropriateAsCapacityTabele( _
                   ByVal roomData As Range) As Boolean
  If roomData.Columns.Count <> 2 Then
    isAppropriateAsCapacityTabele = False
  Else
    isAppropriateAsCapacityTabele = True
  End If
End Function
'///定員データが適切かどうか判定するFunction'
Private Function isAppropriateAsRoomDataTable( _
                   ByRef roomDataArray As Variant) As Boolean
  Dim maxIndex As Integer
  maxIndex = UBound(roomDataArray, 1)
  Dim tmp As Variant
  Dim i As Integer
  For i = 1 To maxIndex
    tmp = roomDataArray(i, 2)
    If Not IsNumeric(tmp) Then _
      isAppropriateAsRoomDataTable = False: Exit Function
    If tmp < 0 Then _
      isAppropriateAsRoomDataTable = False: Exit Function
    If tmp - CInt(tmp) <> 0 Then _
      isAppropriateAsRoomDataTable = False: Exit Function
  Next
  isAppropriateAsRoomDataTable = True
End Function
'///定員オーバーかどうかを判定するFunction'
Private Function isOverCapacity( _
                   ByRef roomDataArray As Variant, _
                   targetNumberOfPeople As Integer) As Boolean
  Dim maxIndex As Integer
  maxIndex = UBound(roomDataArray, 1)
  Dim roomCapacity As Integer
  Dim i As Integer
  For i = 1 To maxIndex
    roomCapacity = roomCapacity + roomDataArray(i, 2)
    If roomCapacity >= targetNumberOfPeople Then _
      isOverCapacity = False: Exit Function
  Next
  isOverCapacity = True
End Function

配下のプロシージャまでずらーっと載せたので、異様にタテ長になってしまった。

フィルターと併用することを考えて、非表示列には振り番しない、という形にした。行き当たりばったりで書いたので、ちょっとグチャグチャになってしまった。

そのあたりはまたいづれ……。

※一応、修正済みです。コチラをどうぞ。

実験

f:id:akashi_keirin:20180219222441j:plain

こんなふうに表を用意して、

f:id:akashi_keirin:20180219222450j:plain

フィルターをかけて、一部を非表示にして、次のコードで実行する。

リスト3 標準モジュール
Public Sub testAllocateRooms()
  Select Case allocateRooms(targetRange:=Selection, _
                            roomData:=ActiveSheet.Range("A1").CurrentRegion, _
                            hasHeader:=True)
    Case assignSuccessed
      MsgBox "部屋割り完了!"
    Case failedByMultipleColumns
      Call makeUserSick("部屋割り結果を書き込む列が2列以上あるやんけぼけーwww")
    Case failedByNotTwoColumnsTable
      Call makeUserSick("部屋定員表が何で2列とちゃうねんぼけーwww")
    Case failedByIrregularRoomDataTable
      Call makeUserSick("部屋定員表が何かおかしいんじゃぼけーwww")
    Case failedByOverCapacity
      Call makeUserSick("定員オーバーじゃぼけーwww")
    Case failedByUnknownReason
      Call makeUserSick("何か知らんけど失敗したやんけぼけーwww")
  End Select
End Sub

実行結果

f:id:akashi_keirin:20180219222457j:plain

f:id:akashi_keirin:20180219222505j:plain

とりあえず、意図通りの結果となった。

おわりに

メインの振り番処理が、ずいぶん簡単に書けるなあ、と思った。</p

あまりにもブサイクなコードなので修正しました

akashi-keirin.hatenablog.com

少しはましになっていると思います。

陰口に負けずに、素人なりにがんばりますよ。はい。