Function РАБЧАСОВ(d_Start As Date, d_End As Date, _
h_Start As Date, h_End As Date, _
Optional WeekEnds As String = "1111100") As Date
If d_Start > d_End Then
РАБЧАСОВ = 0
Exit Function
End If
Dim d As Date, df As Date, hoursAmount As Date
hoursAmount = 0
If Day(d_Start) = Day(d_End) Then
If Mid(WeekEnds, Weekday(d_Start, vbMonday), 1) = "1" Then
' hoursAmount = Min(TimeSerial(Hour(d_End), Minute(d_End), 0), h_End) - _
Max(TimeSerial(Hour(d_Start), Minute(d_Start), 0), h_Start)
hoursAmount = WorksheetFunction.Min(TimeSerial(Hour(d_End), Minute(d_End), 0), h_End) - _
WorksheetFunction.Max(TimeSerial(Hour(d_Start), Minute(d_Start), 0), h_Start)
Else
hoursAmount = 0
End If
Else
d = d_Start
Do While d < d_End
df = DateAdd("n", -1, DateAdd("d", 1, DateSerial(Year(d), Month(d), Day(d))))
If df > d_End Then df = d_End
If Mid(WeekEnds, Weekday(d, vbMonday), 1) = "1" Then
' hoursAmount = hoursAmount + Max(0, Min(TimeSerial(Hour(df), Minute(df), 0), h_End) - _
Max(TimeSerial(Hour(d), Minute(d), 0), h_Start))
hoursAmount = hoursAmount + WorksheetFunction.Max(0, WorksheetFunction.Min(TimeSerial(Hour(df), Minute(df), 0), h_End) - _
WorksheetFunction.Max(TimeSerial(Hour(d), Minute(d), 0), h_Start))
End If
d = DateAdd("d", 1, DateSerial(Year(d), Month(d), Day(d)))
Loop
End If
РАБЧАСОВ = hoursAmount
End Function
'Function РАБЧАСОВ(d_Start As Date, d_End As Date, _
' h_Start As Date, h_End As Date, _
' Optional WeekEnds As String = "1111100") As Date
' If d_Start > d_End Then
' РАБЧАСОВ = 0
' Exit Function
' End If
'
' Dim d As Date, df As Date, hoursAmount As Date
' hoursAmount = 0
'
' If Day(d_Start) = Day(d_End) Then
' If Mid(WeekEnds, Weekday(d_Start, vbMonday), 1) = "1" Then
' hoursAmount = WorksheetFunction.Min(TimeSerial(Hour(d_End), Minute(d_End), 0), h_End) - WorksheetFunction.Max(TimeSerial(Hour(d_Start), Minute(d_Start), 0), h_Start)
' Else
' hoursAmount = 0
' End If
' Else
' d = d_Start
' Do While d < d_End
'
' df = DateAdd("n", -1, DateAdd("d", 1, DateSerial(Year(d), Month(d), Day(d))))
' If df > d_End Then df = d_End
'
' If Mid(WeekEnds, Weekday(d, vbMonday), 1) = "1" Then
' hoursAmount = hoursAmount + WorksheetFunction.Max(0, WorksheetFunction.Min(TimeSerial(Hour(df), Minute(df), 0), h_End) - _
' WorksheetFunction.Max(TimeSerial(Hour(d), Minute(d), 0), h_Start))
' End If
'
' d = DateAdd("d", 1, DateSerial(Year(d), Month(d), Day(d)))
' Loop
'
' End If
'
' РАБЧАСОВ = hoursAmount
'End Function
