VBA 100本ノックNo91
お題
#VBA100本ノック 91本目
— エクセルの神髄 (@yamaoka_ss) 2021年2月19日
「勤怠」に複数月の勤怠データが入っています。
9:00~18:00の休憩1hの実動8hです。
id・月ごとに残業時間を算出し「残業」に一覧出力。
残業:単純に1日8hを超える時間数。ただし9時前出勤は9時とする。
日々1分単位、月間30分単位で切り捨て。
※時間計算の練習問題です。 pic.twitter.com/ROf5vsuL7N
解答コード
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関数で整形するのが理想だと思います。
始業時刻、終業時刻から様々なデータを生成できるのでクラスを活用しています。
そのため、インスタンスのプロパティを変更するだけで、総労働時間や深夜時間を切り替えて集計できます。
個人的な時間計算における時刻データの取り回しは
- 日付型ではなくシリアル値(Double型)で取得
- シリアル値のまま時刻計算
- 端数処理は分単位に変換してから取り回し([シリアル値] ×1440)
- 最後に時刻表記に変換
という方法で基本的に行っています。
回りくどい方法ですが、日付型はシリアル値が1以上になると「時刻のみ」から「日付+時刻」で取り扱われるので直感的に扱いづらいためこのような変換を行っています。
マスタ上の時刻標記が[h]:mm:ss型であるため、労働時間の算出は非常にやりやすかったです。マスタの記述ルールの重要性を実感しました。
日付をまたぐ条件分岐(出題違反以外ですが、今回でいえば深夜時間の算出)はh:mm:ss型にも対応できるように、かなり面倒な処理をしています。