9:00始業なら8:59:59までOKで、9:00の打刻はダメという話を時々聞くが、秒まで記録しない場合はfrom-toどちらも秒を切り捨てるので、9:00の打刻は9:00:00と考えて、問題ないとした方が分かりやすい。
＊＊＊
Ifなどで時刻の条件を書くとき、浮動小数の関係で誤差が生じることがある。セルに入力された値やTimeValue()の値そのままなら問題ないけど、何かしら計算した場合はDateDiff()、あるいはTimeValue()を経由させるなどしたほうが安全。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
Sub test1() Dim tmp As Date tmp = TimeSerial("1", "0", "0") Do While tmp < TimeSerial("22", "00", "0") tmp = DateAdd("n", 1, tmp) Loop Debug.Print Format(tmp, "hh:mm") ' 本来なら22:00になるはずなのに22:01になる End Sub Sub test2() tmp = TimeSerial("1", "0", "0") Do While tmp < TimeSerial("22", "00", "0") tmp = DateAdd("n", 1, tmp) If tmp = TimeSerial("22", "00", "0") Then Debug.Print "Match" ' test1と同じくマッチしない(表示されない) End If Loop ' セルに入力された"22:00"やTimeValue()で作られた22:00ならマッチする End Sub Function test3(tmp As Date) ' tmpはセルに入力された"22:00" If tmp = TimeSerial("22", "00", "0") Then Debug.Print "Match" ' マッチする End If If TimeValue("22:00") = TimeSerial("22", "00", "0") Then Debug.Print "Match" ' マッチする End Function Sub test4() ' 今回のようにループで分を加算した場合の誤差はマイナスのようで、 ' toはマッチ、fromがマッチしない。 Dim tmp As Date tmp = TimeSerial("1", "0", "0") Do While tmp < TimeSerial("23", "00", "0") If tmp >= TimeSerial("22", "00", "0") And tmp <= TimeSerial("22", "15", "0") Then Debug.Print Format(tmp, "hh:mm") ' 22:01 - 22:15 End If tmp = DateAdd("n", 1, tmp) Loop End Sub Function Adjust(tmp) ' これで計算誤差をなくす Adjust = TimeValue(Format(tmp, "hh:mm")) End Function |
＊＊＊
労働時間の計算で15分単位切り捨ての処理をしようとしたが(ちなみに、これは管理会計の話で給与では切り捨てちゃダメ)休憩が15分単位ではなかったので、休憩を挟んで15分をカウントして集計することにした。
こういう計算でループを回すのは悪手だと思うけど、難しいことはできないので、とりあえずループで計算してしまった。。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
Sub test() Call 労働時間("8:00", "11:00", "9:00", "9:02") End Sub Function Adjust(tmp) Adjust = TimeValue(Format(tmp, "hh:mm")) End Function Function 労働時間(出勤 As Date, 退勤 As Date, 外出 As Date, 再入 As Date) ' 出勤調整 If DateDiff("n", 出勤, TimeSerial("8", "0", "0")) > 0 Then 出勤 = TimeSerial("8", "0", "0") workingHour = 0 ' 15分ごとに0.25チャージする counter = 0 Do While DateDiff("n", 出勤, 退勤) > 0 ' 出勤を直接加算している 出勤 = Adjust(出勤) If 出勤 > TimeSerial("10", "0", "0") And 出勤 <= TimeSerial("10", "10", "0") Then ElseIf 出勤 > TimeSerial("12", "0", "0") And 出勤 <= TimeSerial("12", "40", "0") Then ElseIf 出勤 > TimeSerial("15", "0", "0") And 出勤 <= TimeSerial("15", "10", "0") Then ElseIf 出勤 > 外出 And 出勤 <= 再入 Then Else 'Debug.Print Format(出勤, "hh:mm") & "_" & counter counter = counter + 1 End If If counter = 15 Then workingHour = workingHour + 0.25 counter = 0 End If continue: 出勤 = DateAdd("n", 1, 出勤) Loop 労働時間 = workingHour End Function '8:00 '10:00 - 10:10 '12:00 - 12:40 '15:00 - 15:10 '17:00 '11:55～12:50で1チャージとして中に40分の休憩 '14:50～15:15で1チャージとして中に10分の休憩 |
＊＊＊
深夜を入力する場合、VBAでは[h]:mmという表記を扱えないし、セルへの入力でも25:00など入力すると自動で日付が入ってしまうので、セルの書式を文字列に変えてVBAで日付を付加してみた。(今回、セルは時刻だけ入力していたが、セルに日付まで入れてしまったほうが簡単かも知れない)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 |
Function FormatTime(arg) Dim h As Integer Dim m As Integer Dim baseDate As Date: baseDate = "1999/1/1" Dim tmp As Date h = CInt(Left(arg, InStr(arg, ":") - 1)) m = CInt(Mid(arg, InStr(arg, ":") + 1)) If h >= 24 Then tmp = DateAdd("d", 1, baseDate) h = h - 24 Else tmp = baseDate End If FormatTime = CDate(tmp & " " & h & ":" & m) End Function Function ArgCheck(arg) ' :が含まれているかどうか If InStr(arg, ":") = 0 Then ArgCheck = False Exit Function End If ' :の左が数値かどうか hh = Left(arg, InStr(arg, ":") - 1) If IsNumeric(hh) = False Then ArgCheck = False Exit Function End If ' :の右が数値かどうか mm = Mid(arg, InStr(arg, ":") + 1) If IsNumeric(mm) = False Then ArgCheck = False Exit Function End If ArgCheck = True End Function Function GetWorkTime(arg1 As String, arg2 As String, arg3 As String, arg4 As String, arg5 As String, arg6 As String, arg7 As String) If arg1 <> "" And arg2 <> "" Then If ArgCheck(arg1) = False Then Err.Raise (1) If ArgCheck(arg2) = False Then Err.Raise (1) Else GetWorkTime = "" Exit Function End If If arg3 <> "" And arg4 <> "" Then If ArgCheck(arg3) = False Then Err.Raise (1) If ArgCheck(arg4) = False Then Err.Raise (1) Else arg3 = "9:00" ' dummy arg4 = "9:00" End If Dim 出勤 As Date Dim 退勤 As Date Dim 外出 As Date Dim 再入 As Date 出勤 = FormatTime(arg1) 退勤 = FormatTime(arg2) 外出 = FormatTime(arg3) 再入 = FormatTime(arg4) ' 出勤調整 If DateDiff("n", 出勤, TimeSerial("8", "0", "0")) > 0 Then 出勤 = TimeSerial("8", "0", "0") workingHour = 0 ' 15分ごとに0.25チャージする counter = 0 Do While DateDiff("n", 出勤, 退勤) > 0 ' 出勤を直接加算している If 出勤 > CDate("1999/1/1 10:00:00") And 出勤 <= CDate("1999/1/1 10:10:00") Then If arg5 = "未" Then counter = counter + 1 ElseIf 出勤 > CDate("1999/1/1 12:00:00") And 出勤 <= CDate("1999/1/1 12:40:00") Then If arg6 = "未" Then counter = counter + 1 ElseIf 出勤 > CDate("1999/1/1 15:00:00") And 出勤 <= CDate("1999/1/1 15:10:00") Then If arg7 = "未" Then counter = counter + 1 ElseIf 出勤 > 外出 And 出勤 <= 再入 Then Else counter = counter + 1 End If If counter = 15 Then workingHour = workingHour + 0.25 counter = 0 End If continue: 出勤 = DateAdd("n", 1, 出勤) Loop GetWorkTime = workingHour End Function '8:00 '10:00 - 10:10 '12:00 - 12:40 '15:00 - 15:10 '17:00 '11:55～12:50で1チャージとして中に40分の休憩 '14:50～15:15で1チャージとして中に10分の休憩 |