excel - VBA公式计算工作时间
问题描述
我仍然在 VBA 中掌握更复杂的公式。
我想创建一个可以计算某些项目的工作时间的系统。例如,假设我的轮班时间是上午 6 点到下午 330 点。我在 11 月 14 日上午 7 点开始一个项目,并在 11 月 16 日上午 9 点结束。
我将如何进行计算,以便返回值将是我在时钟上工作的时间,而不是滚动的 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
结束功能
解决方案
您可以使用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
这没有考虑周末,但您应该能够轻松添加它。您可以使用工作日功能检查开始日期的工作日是否小于结束日期。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
推荐阅读
- extjs - 如何在网格中调整 multiSortLimit
- wordpress - 联系表格 DB - 导出到 excel 的 WordPress 插件不起作用
- java - junit中'forEach'的依赖关系
- jpa - JPQL 查询:属于多个类别的项目
- python - Scrapy LinkExtractor 找不到现有的 url
- python - Python/Azure 输出文件名
- haskell - 为什么我在 haskell 中的 gcd 函数仅在返回类型 Writer [String] Int 而不是 Writer String Int 时才起作用?
- ionic3 - 如何使用本地存储检索阵列
- python - 尝试为对手的每次变化重置列
- html - 如何制作 div 和 svg 的视频背景?