VBA 计算工作时间的公式

Question

我仍在掌握 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 点前结束怎么办结果 = DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) 结果 = 结果 + DateDiff("n", TimeValue("08:00:00"), EnDateT, vbUseSystemDayOfWeek) '检查这两天是否休息。如果 DateDiff("n", StDateT, TimeValue("17:00:00"), vbUseSystemDayOfWeek) > (5 * 60) 然后结果 = 结果 - 60 结束如果

    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

结束函数

Answer 1

您可以使用 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。如果您的项目持续一周以上，您可以查找并减去更多周末：

' 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

VBA 计算工作时间的公式

VBA Formula to calculate Hours Worked

excel

vba

calculation