查找两个date之间的date/时间差异，不包括周末/下class时间和退货x Days y Hrs zz Mins
我的工作时间是星期一至星期五09:00至17:00。 我有一个小组，检测单元格是否已被修改在第5列，并返回它在第6列中相应单元格中修改的时间戳。我的问题是，我想减去列3中的交货date和时间戳之间的值并在第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 编辑：在最后…一个工作解决scheme！ 让我知道这个是否奏效！
首先找出多less天（平日），然后找出剩余的小时数和分钟数（ SoD和EoD为开始date和结束date），如果这些分钟超过一天，则将其添加到总天数中，然后通过分出分钟find剩余的小时数，然后在几分钟内剩下剩下的小时数。 让我知道这个是否奏效。
编辑：添加一个检查，如果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