MyTetra Share
Делитесь знаниями!
Рабочее время
23.02.2020
12:36
Текстовые метки: РАБЧАСОВ, рабочее время
Раздел: !Закладки - VBA

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




Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования