|
|
Calculating Working DaysQuestionI want to do a calculation between two dates ie, 22/1/99 and 5/5/99 and
calculate the number of working days in the range. I am prepared to ignore bank
holidays and holy days. AnswerMark, '*+
' Public domain. Written by Shamil Salakhetdinov. 1996.
' DARTS Ltd., St.Petersburg, Russia
' e-mail: shamil@marta.darts.spb.ru
' URL: http//marta.darts.spb.ru
'*-
'
' Function smsQtyOfWorkingDays (pvarStartDate As Variant, pvarEndDate As
Variant) As Integer
'
' This function calculates the quantity of working days between two dates.
' If StartDate > EndDate result is negative.
'
'*-
'
' The speed of calculation does not depend on the quantity of workingdays
between two dates.
' Below are the test measurements of the calculation speed compared with
the WorkDays() function
' ('The Key to Access' April 1996). Test environment: Pentium 166, 32MB,
Win95, MS Access 2.0 .
' Test functions were cycled 1000 times calculating workdays.
'
' SDate EDate WorkDaysQty WorkDays()
smsQtyOfWorkingDaysBetween2WeekDays(..)
' ----- ------ ----------- -------------------------- -------------
--------------------------
' '1/1/96 - 1/2/96: 23 workdays, ~10s, 1.15740738692693E-07 - < 1s,
1.15740767796524E-08
' '1/1/96 - 1/3/96: 44 workdays, ~20s, 2.19907407881692E-07 - < 1s,
1.15740767796524E-08
' '1/1/96 - 1/3/96, 65 workdays, ~30s, 3.47222223354038E-07 - < 1s,
1.15740695036948E-08
' ...
' '1/1/66 - 1/4/96, 7890 workdays, --- ??? --- - < 1s,
1.15740767796524E-08
'*-
Function smsQtyOfWorkingDays(pvarStartDate As Variant, pvarEndDate As
Variant) As Integer
On Error GoTo smsQtyOfWorkingDays_Err
Dim lngStartDate As Long, lngEndDate As Long
lngStartDate = CLng(CVDate(pvarStartDate))
lngEndDate = CLng(CVDate(pvarEndDate))
If lngStartDate <= lngEndDate Then
smsQtyOfWorkingDays = DateDiff("w", lngStartDate, lngEndDate) * 5 +
smsQtyOfWorkingDaysBetween2WeekDays(WeekDay(lngStartDate),
WeekDay(lngEndDate))
Else
lngStartDate = CLng(CVDate(pvarEndDate))
lngEndDate = CLng(CVDate(pvarStartDate))
smsQtyOfWorkingDays = -(DateDiff("w", lngStartDate, lngEndDate) * 5 +
smsQtyOfWorkingDaysBetween2WeekDays(WeekDay(lngStartDate),
WeekDay(lngEndDate)))
End If
smsQtyOfWorkingDays_Done:
Exit Function
smsQtyOfWorkingDays_Err:
Resume smsQtyOfWorkingDays_Done
End Function
'*+
'
' This function calculates the quantity of working days
' between two WeekDays. The weekdays' numbers are:
'
' Sun Mon Tue Wed Thu Fri Sat
' |---|---|---|---|---|---|
' 1 2 3 4 5 6 7
'
'*-
Function smsQtyOfWorkingDaysBetween2WeekDays(intFirstWeekDay As Integer,
intSecondWeekDay As Integer)
On Error GoTo smsQtyOfWorkingDaysBetween2WeekDays_Err
smsQtyOfWorkingDaysBetween2WeekDays = 0
Dim intForIdx As Integer, intCycle2 As Integer, intCnt As Integer
intCnt = 0
If intFirstWeekDay <> intSecondWeekDay Then
If intFirstWeekDay < intSecondWeekDay Then
intCycle2 = intSecondWeekDay
Else
intCycle2 = intSecondWeekDay + 7
End If
For intForIdx = intFirstWeekDay To intCycle2 - 1
Select Case intForIdx Mod 7
Case 1, 7:
Case 2, 3, 4, 5, 6: intCnt = intCnt + 1
Case Else
End Select
Next intForIdx
End If
smsQtyOfWorkingDaysBetween2WeekDays = intCnt
smsQtyOfWorkingDaysBetween2WeekDays_Done:
Exit Function
smsQtyOfWorkingDaysBetween2WeekDays_Err:
Resume smsQtyOfWorkingDaysBetween2WeekDays_Done
End Function
Copyright © 1999-2008 by Shamil Salakhetdinov. Original version is published here All rights reserved. |