スケジュール管理表を作成 ⑤ その日に出来る範囲を把握してみる

先日から、スケジュール管理票をExcelで作成している。
infoment.hatenablog.com
今日も、先日の続きから。
f:id:Infoment:20210116221706p:plain

これから少し、シートの塗りつぶしなどによる見える化も行っていく予定。
そのために、見た目は極力質素にしておきたい。

ということで、見た目を少し変えてみた。
f:id:Infoment:20210116222349p:plain

ところで、このスケジュールには問題がある。日本全体の問題と言っても
良いかもしれない。それは「終わり時間を気にしていない」という問題だ。
一日は、有限だ。終わり時間を決めて、その日に出来る範囲を線引きして
おきたい。

Public Sub UpdateTable()
    
    ' スケジュール表。
    Dim Tb As ListObject
    Set Tb = ActiveSheet.ListObjects(1)
    
    ' ループ用。
    Dim ListRow As Excel.ListRow
        
        ' 更新前の罫線を削除。
        Tb.DataBodyRange.Borders.LineStyle = xlNone
        
        ' 終業時刻を超える案件に罫線を引く。
        On Error Resume Next
        For Each ListRow In Tb.ListRows
            If ListRow.Range(列名.en終了予定時刻) >= Range("終業予定") Then
                ListRow.Range.Borders.Item(xlEdgeBottom).Weight = xlThin
                Exit For
            End If
        Next
        On Error GoTo 0
        
End Sub

この更新は、作業予定時間または終了時刻が更新されたことを切っ掛けに
実行するとしよう。
↓ シートモジュール。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ListRow As Excel.ListRow
        Select Case Target.Column - Tb.Range(1).Column + 1
            Case 列名.en作業予定時間
                For Each ListRow In Tb.ListRows
                    With ListRow
                        
                        .Range(列名.en●).Font.Size = wf.MRound(6 * (Hour(.Range(列名.en作業予定時間)) + _
                                                                     Minute(.Range(列名.en作業予定時間)) / 60) + 1, 2)
                    End With
                Next
        
            Case 列名.en作業予定時間, 列名.en終了時刻
                Call UpdateTable
        
        End Select
End Sub

結果、本日の終業予定を17:00とした場合、案件Ｈ以降は明日以降に回さざるを
得ないことが視覚的にわかる。
※その結果を受けて、リスケジューリングするのか、或いは優先順位を変えるか
　を考えることになる。
f:id:Infoment:20210116223701p:plain

ところで、案件によっては昼休みをまたぐものも出てくるだろう。そこで、
昼休みボタンを設けることにした。
f:id:Infoment:20210116224130p:plain

これを押すことで、現在進行中の案件を一旦中断し、昼休みののちに再開する
ようなスケジュールの引き直しが出来る。またそれに、終業予定時刻が追従し
変更される。

↓ シートモジュール。

Private Sub cb昼休み_Click()
    Call SetLunchBreak
End Sub

↓ 標準モジュール。

Public Sub SetLunchBreak()

    Dim Tb As ListObject
    Set Tb = ActiveSheet.ListObjects(1)
        Tb.DataBodyRange.Interior.Color = xlNone

    ' 直近の終了時刻セル。
    Dim LatestRange As Range
    Set LatestRange = Tb.ListRows(Tb.ListRows.Count).Range(列名.en終了時刻).End(xlUp)
    
        If LatestRange >= TimeValue("13:00") Then
            MsgBox "既に昼休み以降の作業を実施中です。"
            Exit Sub
        Else
            LatestRange.Offset(1) = "12:00"
        End If
    
    ' 直近の終了時刻セルの、テーブル内の行番号。
    Dim RowIndex As Long
        RowIndex = LatestRange.Row - Tb.Range(1).Row
    Dim ListRow As Excel.ListRow
    Set ListRow = Tb.ListRows.Add(RowIndex + 2)
        With ListRow
            .Range(列名.en実施内容) = "昼休み"
            .Range(列名.en作業予定時間) = "1:00"
            .Range(列名.en終了時刻) = "13:00"
            .Range.Interior.Color = RGB(240, 240, 240)
        End With
    
    Set ListRow = Tb.ListRows.Add(RowIndex + 3)
        ListRow.Range(列名.en実施内容) = Tb.ListRows(RowIndex + 1).Range(列名.en実施内容)
        ListRow.Range(列名.en作業予定時間) = Tb.ListRows(RowIndex + 1).Range(列名.en作業予定時間)
        ListRow.Range(列名.en備考) = Tb.ListRows(RowIndex + 1).Range(列名.en備考)

End Sub