Temat: Liczenie daty w tył na bazie business days
Witam, dziękuję za opisane podpowiedzi. W końcu skończyło się na poniższym kodzie. Pewnie można to zrobić łatwiej, ale działa. :)
-----------------------------------------------------------------------------------------------------------------------------
Public Function MinusCalendarDays(StartDate As Date, BusinessDays As Integer, Optional ReturnDate As Boolean) As Variant
' Jesli "ReturnDate" = True funkcja podaje date odlegla o "BusinessDays" dni roboczych od "StartDate" wstecz
' (w tej wersji jest uzywana w aplikacji)
'
' Do obliczec wymaga funkcji IsHoliday (sprawdza czy mamy po drodze swieto), bazuje na tabeli "Holidays"
' oraz IsWeekend (sprawdza czy po drodze jest weekend)
StartDate = DateAdd("d", -1, StartDate)
Dim i As Integer: i = 0
Do Until i = BusinessDays
If IsWeekend(StartDate - i) = True Then
BusinessDays = BusinessDays + 1
Else
If IsHoliday(StartDate - i) = True Then BusinessDays = BusinessDays + 1
End If
i = i + 1
Loop
MinusCalendarDays = BusinessDays
If ReturnDate = True Then MinusCalendarDays = StartDate - MinusCalendarDays + 1
End Function
-----------------------------------------------------------------------------------------------------------------------------
Public Function IsHoliday(QueryDate As Date) As Boolean
Dim nHolidays As Integer
Dim strWhere As String
' Funkcja wymagana przez funckje "CalendarDays"
'
' Wymaga tabeli "Holidays" z polem [Holiday] gdzie powinny byc wpisane daty swiat
strWhere = "[Holiday] = #" & Format(QueryDate, "yyyy-mm-dd") & "#"
' Count the number of holidays.
nHolidays = DCount(Expr:="[Holiday]", _
Domain:="Holidays", _
Criteria:=strWhere)
If nHolidays = 1 Then
IsHoliday = True
Else
IsHoliday = False
End If
End Function
-----------------------------------------------------------------------------------------------------------------------------
Public Function IsWeekend(QueryDate As Date) As Boolean
' Funkcja wymagana przez funckje "CalendarDays"
Select Case Weekday(QueryDate, vbMonday)
Case 6
IsWeekend = True
Case 7
IsWeekend = True
End Select
End Function