주말/근무 시간 외의 두 날짜 간의 날짜/시간 차이를 찾아 x 일을 반환합니다. 일 수 y 시간 zz 수령

Question

근무 시간은 월요일에서 금요일 오전 9시에서 오후 7시 사이입니다. 나는 셀이 열 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

EDIT : AT LONG LAST ... 작업 솔루션! 이게 작동하는지 알려주세요. 그 분은 하루 이상있는 경우

첫째는, 다음 나머지 시간과 분 (SoD 하루의 시작 및 하루의 끝을위한 EoD)을 알게 방법 일 (평일) 많은 알게, 그것은 추가 그것은 총 일로, 분을 나눔으로써 남은 시간을 찾은 다음 나머지를 분 안에 남겨 둡니다. 이것이 작동하는지 알려주세요.

편집 : ReqDate가 주말인지 확인했습니다. 다음 공식 사용 셀 A1에서 장소 시작 날짜, A2에서 종료 날짜 :

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