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

部屋割りマクロのリファクタリング

f:id:akashi_keirin:20180217113941p:plain

Ifブロック内のDo～Loop

ある程度コードが組み上がってから、

あ、この場合分けを見落としていたよ！

ということに気づいて、慌ててコードを付け足したりしたときに、マヌケなコードを書いてしまうことがよくある（よね？）。

前回の

akashi-keirin.hatenablog.com

この記事のリスト１でいうと、

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

この部分ですよ。

単純化すると、

もし○が非Ａならば、
○がＡになるまで処理×を行え。

ってことですからね。

こんなの、始めから

○が非Ａである間は処理×を行え。

で済むじゃないかｗｗｗ

コードの書き換え

というわけで、該当部分を次のように書き換えました。

With targetRange.Cells(i, 1)
  '振り番しようとする部屋が定員に達していたら次の部屋に進める'
  Do While loopOfArray > roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 2)
    getFromArrayCount = getFromArrayCount + 1
    loopOfArray = (getFromArrayCount - 1) \ rowCount + 1
  Loop
  .Value = roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 1)
  getFromArrayCount = getFromArrayCount + 1
End With

コード全文

いちおう、修正後のコード全文を載っけておく。

リスト１　標準モジュール

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)
      '振り番しようとする部屋が定員に達していたら次の部屋に進める'
      Do While loopOfArray > roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 2)
        getFromArrayCount = getFromArrayCount + 1
        loopOfArray = (getFromArrayCount - 1) \ rowCount + 1
      Loop
      .Value = roomDataArray(((getFromArrayCount - 1) Mod rowCount + 1), 1)
      getFromArrayCount = getFromArrayCount + 1
    End With
  Next
  assignOfRooms = True
  Exit Function
errorHandler:
  assignOfRooms = False
End Function