[英]VBA Formula to calculate Hours Worked
我仍然掌握 VBA 中更復雜的公式。
我想創建一個可以計算某些項目的工作時間的系統。 例如,假設我的輪班時間是上午 6 點到下午 330 點。 我在 11 月 14 日上午 7 點開始一個項目,並在 11 月 16 日上午 9 點結束。
我將如何 go 進行計算,以便返回值將是我在時鍾上工作的時間,而不是滾動的 24 小時計算? (同時盡可能跳過周末?)
謝謝..繼承人我試圖使用的代碼....
Public Function NetWorkHours(dteStart As Date, dteEnd As Date) As Integer
Dim StDate As Date
Dim StDateD As Date
Dim StDateT As Date
Dim EnDate As Date
Dim EnDateD As Date
Dim EnDateT As Date
Dim WorkDay1Start As Date
Dim WorkDay1end As Date
Dim WorkDay2Start As Date
Dim WorkDay2end As Date
Dim Result As Integer
Dim MinDay As Integer
StDate = CDate(dteStart)
EnDate = CDate(dteEnd)
WorkDay1Start = DateValue(StDate) + TimeValue("08:00:00")
WorkDay1end = DateValue(StDate) + TimeValue("17:00:00")
WorkDay2Start = DateValue(EnDate) + TimeValue("08:00:00")
WorkDay2end = DateValue(EnDate) + TimeValue("17:00:00")
If (StDate > WorkDay1end) Then
StDate = DateAdd("d", 1, WorkDay1Start)
End If
If (StDate < WorkDay1Start) Then
StDate = WorkDay1Start
End If
If (EnDate > WorkDay2end) Then
EnDate = DateAdd("d", 1, WorkDay2Start)
End If
If (EnDate < WorkDay2Start) Then
EnDate = WorkDay2Start
End If
StDateD = CDate(Format(StDate, "Short Date"))
EnDateD = CDate(Format(EnDate, "Short Date"))
If StDateD = EnDateD Then
Result = DateDiff("n", StDate, EnDate, vbUseSystemDayOfWeek)
Else
MinDay = (8 * 60) 'Number of minutes of a working day. Change this if you change the start and end times.
'Extract the time from the two timestamps
StDateT = Format(StDate, "Short Time")
EnDateT = Format(EnDate, "Short Time")
' '計算第一天和第二天的分鍾。 如果開始在下午 5 點之后或結束在早上 8 點之前,還不知道該怎么做 Result = DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) Result = Result + DateDiff(" n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek) '檢查兩天是否有休息。 If DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) > (5 * 60) Then Result = Result - 60 End If
If DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek) > (5 * 60) Then
Result = Result - 60
End If
'Add 1 day to start date. This is to start the loop to get all the days between both dates.
StDateD = DateAdd("d", 1, StDateD)
Do Until StDateD = EnDateD
'If the date is not a saterday or a sunday we add one day.
If (Weekday(StDateD) > 1) And (Weekday(StDateD) < 7) Then
Result = Result + MinDay
'Check for the holiday. If the date is a holiday, then we remove one day
If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(StDateD) & "#")) Then
Result = Result - MinDay
End If
End If
StDateD = DateAdd("d", 1, StDateD)
Loop
End If
NetWorkHours = Result
結束 Function
您可以使用DateDiff
計算日期(和時間)之間的差異。 以下應該讓您非常接近您想要做的事情:
Dim datStart As Date
Dim datEnd As Date
Dim sngShiftStart As Single
Dim sngShiftEnd As Single
Dim sngShiftDuration As Single
Dim lngMinutesWorked As Long
Dim lngOfftime As Long
Dim sngHoursWorked As Single
' Calculate shift length
sngShiftStart = 6
sngShiftEnd = 15.5
sngShiftDuration = sngShiftEnd - sngShiftStart
' Set start and end times
datStart = CDate("11/07/19 7:00")
datEnd = CDate("11/09/19 8:30")
lngMinutesWorked = DateDiff("n", datStart, datEnd)
lngOfftime = ((24 - sngShiftDuration) * 60) * (DateDiff("d", datStart, datEnd))
sngHoursWorked = (lngMinutesWorked - lngOfftime) / 60
MsgBox sngHoursWorked
這沒有考慮周末,但您應該能夠輕松添加它。 如果開始日期的工作日小於結束日期,您可以使用Weekday function檢查。 在這種情況下,從 sngHoursWorked 中減去2 * sngShiftDuration
sngHoursWorked
。 如果您的項目持續超過一周,您可以查找並減去更多周末:
' Remove weekends
Dim sngWeekendHours As Single
If Weekday(datStart) > Weekday(datEnd) Then
' Weekend included
sngWeekendHours = (2 * sngShiftDuration) * (DateDiff("w", datStart, datEnd) + 1)
End If
sngHoursWorked = ((lngMinutesWorked - lngOfftime) / 60) - sngWeekendHours
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.