凡人も語りたい

VBAに関すことや日々考えている事柄について投稿しようと思っています。

VBA 100本ノックNo91

お題

解答コード

Class1 コード(クラスモジュール)

Option Explicit
Private rest As Integer
Private St1_ As Double
Private fin1_ As Double
Private WT_ As Long
Private Ded_ As Long
Private NT_ As Long
Private Ovt_ As Integer
'Letプロパティの一括設定
Sub SetProp(ByVal new_st1 As Double, ByVal new_fin1 As Double)
    rest = 60 '休憩時間 60分
    If new_st1 < TimeSerial(9, 0, 0) Then
        St1_ = 9 / 24 '9時のシリアル値
    Else
        St1_ = new_st1
    End If
    fin1_ = new_fin1
    WT_ = WorkTime
    Ovt_ = OverTime
    NT_ = Night
End Sub
'労働時間の計算
Private Function WorkTime() As Long
    Dim WT As Double
    WT = fin1_ - St1_
    WorkTime = WorksheetFunction.RoundDown((WT) * 1440, 0) - rest
End Function
'残業時間の計算
Private Function OverTime() As Integer
    If WT_ > 480 Then
        OverTime = WT_ - 480
    Else
        OverTime = 0
    End If
End Function
'深夜時間の計算
Private Function Night() As Long
    Dim i As Long, dbStr As Double, dbFin As Double, dbNT As Long
    dbStr = St1_
    If fin1_ >= 1 Then
        dbFin = fin1_ - 1
    Else
        dbFin = fin1_
    End If
'始業時刻の条件分岐
'始業時刻が0時~5時までかつ、
    If dbStr < TimeSerial(5, 0, 0) Then
'終業時刻が0時~5時までの場合
        If dbFin < TimeSerial(5, 0, 0) Then
            dbNT = WorksheetFunction.RoundDown((dbFin - dbStr) * 1440, 0)
'終業時刻が22時~24時までの場合
        ElseIf dbFin > TimeSerial(22, 0, 0) Then
            dbNT = WorksheetFunction.RoundDown(((5 / 24 - dbStr) + dbFin - 22 / 24) * 1440, 0)
'終業時刻が5時~24時までの場合
        Else
            dbNT = WorksheetFunction.RoundDown((5 / 24 - dbStr) * 1440, 0)
        End If
'始業時刻が22時~24時までかつ、
    ElseIf dbStr >= TimeSerial(22, 0, 0) Then
'終業時刻が0時~5時までの場合
        If dbFin < TimeSerial(5, 0, 0) Then
            dbNT = WorksheetFunction.RoundDown((dbFin + (1 - dbStr)) * 1440, 0)
'終業時刻が22時~24時までの場合
        ElseIf dbFin > TimeSerial(22, 0, 0) Then
            dbNT = WorksheetFunction.RoundDown(((dbFin - dbStr) + dbFin - 22 / 24) * 1440, 0)
'終業時刻が5時~24時までの場合
        Else
            dbNT = WorksheetFunction.RoundDown((5 / 24 + (1 - dbStr)) * 1440, 0)
        End If
'始業時刻が8時~22時までかつ、
    Else
'終業時刻が0時~5時までの場合
        If dbFin < TimeSerial(5, 0, 0) Then
            dbNT = WorksheetFunction.RoundDown((dbFin + 2 / 24) * 1440, 0)
'終業時刻が22時~24時までの場合
        ElseIf dbFin > TimeSerial(22, 0, 0) Then
            dbNT = WorksheetFunction.RoundDown((dbFin - 22 / 24) * 1440, 0)
'終業時刻が翌日5時~8時までの場合
        ElseIf dbFin < dbStr Then
            dbNT = 420
'終業時刻が8時~24時までの場合
        Else
            dbNT = 0
        End If
    End If
    Night = dbNT
End Function
’プロパティ取得の設定
Property Get 勤務時間() As Double
    勤務時間 = WT_
End Property
Property Get 深夜時間() As Double
    深夜時間 = NT_
End Property
Property Get 始業時刻() As Double
    始業時刻 = St1_
End Property
Property Get 終業時刻() As Double
    終業時刻 = fin1_
End Property
Property Get 残業時間() As Integer
    残業時間 = Ovt_
End Property

Module1 コード(標準モジュール)

Sub ノック91本目()
    Dim ID As Integer
    Dim Dic_ID As Object: Set Dic_ID = CreateObject("Scripting.Dictionary")
    Dim cnt_ID As Long
    Dim y As Integer, m As Integer
    Dim 年月 As String
    Dim Dic_年月 As Object: Set Dic_年月 = CreateObject("Scripting.Dictionary")
    Dim cnt_年月 As Long
    Dim i As Long
'ID,年月に関する連想配列生成と二次元配列の要素数決定
    For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
        ID = Sheet1.Cells(i, 1).Value
        年月 = Nengetsu(Sheet1.Cells(i, 2).Value)
        If Not (Dic_ID.exists(ID)) Then
            cnt_ID = cnt_ID + 1
            Dic_ID.Add ID, cnt_ID
        End If
        If Not (Dic_年月.exists(年月)) Then
            cnt_年月 = cnt_年月 + 1
            Dic_年月.Add 年月, cnt_年月
        End If
    Next
'ID,年月ごとの残業時間集計
    Dim obj As Class1
    Dim StartTime As Double, FinishTime As Double
    Dim arr() As Variant
    ReDim arr(1 To cnt_ID, 1 To cnt_年月) As Variant
    For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
        ID = Sheet1.Cells(i, 1).Value
        年月 = Nengetsu(Sheet1.Cells(i, 2).Value)
        StartTime = Sheet1.Cells(i, 3).Value
        FinishTime = Sheet1.Cells(i, 4).Value
        Set obj = New Class1
        obj.SetProp StartTime, FinishTime
        arr(Dic_ID(ID), Dic_年月(年月)) = arr(Dic_ID(ID), Dic_年月(年月)) + obj.残業時間
        Set obj = Nothing
    Next

'残業シートへの転記
    Dim j As Long, k As Long, r As Long
    Dim Keys_ID As Variant: Keys_ID = Dic_ID.keys
    Dim Keys_年月 As Variant: Keys_年月 = Dic_年月.keys
    r = 1
    For j = 1 To cnt_ID
        For k = 1 To cnt_年月
            r = r + 1
            Sheet2.Cells(r, 1).Value = Keys_ID(j - 1)
            Sheet2.Cells(r, 2).Value = Keys_年月(k - 1)
            If arr(j, k) Mod 60 < 30 Then
                Sheet2.Cells(r, 3).Value = "'" & arr(j, k) \ 60 & ":00"
            Else
                Sheet2.Cells(r, 3).Value = "'" & arr(j, k) \ 60 & ":30"
            End If
        Next
    Next
End Sub

'年月文字列を生成する関数
Function Nengetsu(ByVal d As Date) As String
    Nengetsu = Year(d) & Month(d)
    If Month(d) > 9 Then
        Nengetsu = Year(d) & Month(d)
    Else
        Nengetsu = Year(d) & "0" & Month(d)
    End If
End Function

振り返りと感想

完成まで3時間。以前に近いものを作った経験があったのでそのノウハウを応用。
表記は文字列で扱っており手抜き…本来はFormat関数やNunberFormat関数で整形するのが理想だと思います。
始業時刻、終業時刻から様々なデータを生成できるのでクラスを活用しています。
そのため、インスタンスのプロパティを変更するだけで、総労働時間や深夜時間を切り替えて集計できます。

個人的な時間計算における時刻データの取り回しは

  1. 日付型ではなくシリアル値(Double型)で取得
  2. シリアル値のまま時刻計算
  3. 端数処理は分単位に変換してから取り回し([シリアル値] ×1440)
  4. 最後に時刻表記に変換

という方法で基本的に行っています。

回りくどい方法ですが、日付型はシリアル値が1以上になると「時刻のみ」から「日付+時刻」で取り扱われるので直感的に扱いづらいためこのような変換を行っています。
マスタ上の時刻標記が[h]:mm:ss型であるため、労働時間の算出は非常にやりやすかったです。マスタの記述ルールの重要性を実感しました。
日付をまたぐ条件分岐(出題違反以外ですが、今回でいえば深夜時間の算出)はh:mm:ss型にも対応できるように、かなり面倒な処理をしています。