部屋割りマクロ(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
ひとまず、こんな感じ。非常に単純な作りのクラス。
部屋割り用プロシージャ
こいつの「振り番処理」の部分を、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
配下のプロシージャまでずらーっと載せたので、異様にタテ長になってしまった。
フィルターと併用することを考えて、非表示列には振り番しない、という形にした。行き当たりばったりで書いたので、ちょっとグチャグチャになってしまった。
そのあたりはまたいづれ……。
※一応、修正済みです。コチラをどうぞ。
実験
こんなふうに表を用意して、
フィルターをかけて、一部を非表示にして、次のコードで実行する。
リスト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
実行結果
とりあえず、意図通りの結果となった。
おわりに
メインの振り番処理が、ずいぶん簡単に書けるなあ、と思った。</p
あまりにもブサイクなコードなので修正しました
少しはましになっていると思います。
陰口に負けずに、素人なりにがんばりますよ。はい。