Question

我的工作时间是周一至周五的09:00至17:00。我有一个sub，它检测是否在第5列中修改了一个单元格，并在第6列中的相应单元格中返回它被修改的时间戳。我的问题是，我想减去第3列中的交付日期和时间戳之间的值并在第8列的相应单元格中返回类似“2天3小时20分钟”的值。任何帮助都会让我免于这种偏头痛。提前致谢。以下是我目前的代码。

Sub WorkSheet_Change(ByVal Target As Range)
Dim DeliveryDate As Date
Dim DayCount As Long
Dim EoD As Date
Dim SoD As Date
Dim StartDiff As Long
Dim EndDiff As Long
Dim TotalDiff As Long
Dim TotalHrs As Long

DayCount = 0
DeliveryDate = Cells(Target.Row, 6).Value

For x = Day(Now) + 1 To Day(DeliveryDate) - 1
D = Weekday(x)
If D <> 1 And D <> 7 Then DayCount = DayCount + 1
Next x
EoD = DateSerial(Year(Now), Month(Now), Day(Now)) + TimeSerial(17, 0, 0)
SoD = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(9, 0, 0)
StartDiff = DateDiff("n", Now, EoD)
EndDiff = DateDiff("n", SoD, DeliveryDate)
If StartDiff + EndDiff >= 480 Then
    DayCount = DayCount + 1
    TotalDiff = StartDiff + EndDiff - 480
Else
    TotalDiff = StartDiff + EndDiff
End If
If TotalDiff >= 60 Then
    TotalHrs = TotalDiff \ 60
    TotalDiff = TotalDiff Mod 60
Else
    TotalHrs = 0
End If

Application.EnableEvents = False
If Target.Column = 5 Then

If Target.Value Like "*" Then
Cells(Target.Row, 7).Value = DateTime.Now 'Timetamp
Cells(Target.Row, 8).Value = DayCount & " Business Days, " & TotalHrs & " Business Hours, " &               TotalDiff & " Business Mins Remain"
End If

If Target.Value = "" Then
Cells(Target.Row, 7).Value = ""
Me.Cells(Target.Row, 8).Value = ""
End If
Application.EnableEvents = True
End If

End Sub

Answer 1

编辑：最后......一个有效的解决方案！如果有效，请告诉我们！

首先找出天数（工作日），然后找出剩余的小时和分钟（SoD和EoD表示开始日期和结束日期，然后是那些分钟是超过一天，它将总数添加到总天数，然后通过除以分钟数找到剩余小时数，然后在几分钟内剩余时间。如果有效，请告诉我。

编辑：已添加检查ReqDate是否在周末。

Sub WorkSheet_Change(ByVal Target As Range)

Dim DeliveryDate As Date
Dim ReqDate As Date
Dim MonDate As Date
Dim DayCount As Long
Dim EoD As Date
Dim SoD As Date
Dim NextSoD As Date
Dim StartDiff As Long
Dim EndDiff As Long
Dim TotalDiff As Long
Dim TotalHrs As Long

DayCount = 0

MonDate = Cells(1, 8).Value

'Application.EnableEvents = False
If Target.Column = 6 Then

If Target.Value Like "*" Then
Cells(Target.Row, 7).Value = DateTime.Now 'Timetamp
End If

If Target.Value = "" Then
Cells(Target.Row, 7).Value = ""
Me.Cells(Target.Row, 8).Value = ""
End If

Select Case ActiveSheet.Name
    Case "Monday"
        DeliveryDate = MonDate
    Case "Tuesday"
        DeliveryDate = DateAdd("d", 1, MonDate)
    Case "Wednesday"
        DeliveryDate = DateAdd("d", 2, MonDate)
    Case "Thursday"
        DeliveryDate = DateAdd("d", 3, MonDate)
    Case "Friday"
        DeliveryDate = DateAdd("d", 4, MonDate)
    Case Else
        MsgBox "Name of Sheet is not a proper Day of Week"
        Exit Sub
End Select

Select Case Cells(Target.Row, 3).Value
    Case 1
        DeliveryDate = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(9, 30, 0)
    Case 2
        DeliveryDate = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(10, 30, 0)
    Case 3
        DeliveryDate = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(11, 30, 0)
    Case 4
        DeliveryDate = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(12, 30, 0)
    Case 5
        DeliveryDate = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(13, 30, 0)
    Case 6
        DeliveryDate = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(14, 30, 0)
    Case Else
        MsgBox "Delivery Window is not a valid number 1-6"
        Exit Sub
End Select

ReqDate = Cells(Target.Row, 7).Value

If ReqDate < DateSerial(Year(ReqDate), Month(ReqDate), Day(ReqDate)) + TimeSerial(9, 0, 0) Then
    ReqDate = DateSerial(Year(ReqDate), Month(ReqDate), Day(ReqDate)) + TimeSerial(9, 0, 0)
ElseIf ReqDate > DateSerial(Year(ReqDate), Month(ReqDate), Day(ReqDate)) + TimeSerial(17, 0, 0) Then
    ReqDate = DateSerial(Year(ReqDate), Month(ReqDate), Day(ReqDate) + 1) + TimeSerial(9, 0, 0)
Else
End If

Select Case Weekday(ReqDate)
    Case 7
        ReqDate = DateAdd("d", 2, ReqDate)
    Case 1
        ReqDate = DateAdd("d", 1, ReqDate)
    Case Else
End Select

Cells(Target.Row, 8).Value = DeliveryDate

    EoD = DateSerial(Year(ReqDate), Month(ReqDate), Day(ReqDate)) + TimeSerial(17, 0, 0)
    SoD = DateSerial(Year(DeliveryDate), Month(DeliveryDate), Day(DeliveryDate)) + TimeSerial(9, 0, 0)
    NextSoD = DateAdd("h", 16, EoD)
    DayCount = Application.WorksheetFunction.NetworkDays(NextSoD, SoD) - 1
    StartDiff = DateDiff("n", ReqDate, EoD)
    EndDiff = DateDiff("n", SoD, DeliveryDate)
    If StartDiff + EndDiff >= 480 Then
        DayCount = DayCount + 1
        TotalDiff = StartDiff + EndDiff - 480
    Else
        TotalDiff = StartDiff + EndDiff
    End If
    If TotalDiff >= 60 Then
        TotalHrs = TotalDiff \ 60
        TotalDiff = TotalDiff Mod 60
    Else
        TotalHrs = 0
    End If
If DayCount < 0 Or TotalHrs < 0 Or TotalDiff < 0 Then
    Cells(Target.Row, 9).Value = "Error: Delivery Date is BEFORE requested date"
    Else
    Cells(Target.Row, 9).Value = DayCount & " Business Days, " & TotalHrs & " Business Hours, " & TotalDiff & " Business Mins Remain"
End If
'Application.EnableEvents = True
End If

End Sub

查找两个日期之间的日期/时间差异，不包括周末/下班时间，并返回x天和小时zz分钟

1 个答案: