Microsoft Access Новое сообщение

Количество выходных (Сб. и Вс.) между 2 произвольными датами: поделитесь функцией

Alex112

Дата: 09.09.2005 09:24:06

Наверняка, кто-то уже это делал. Поделитесь, пожалуйста! Праздничные дни учитавать не нужно ...

Дата: 09.09.2005 10:00:00

Date/Time: Doing WorkDay Math in VBA

Alex112

Дата: 09.09.2005 10:33:11

PA

Спасибо. Посмотрел там CountHolidaysA(). Не очень понравилось то, что ей нужно передавать массив дат с начальной по конечную и потом пробегать по нему циклом. С массивом пусть и быстро, но уж больно неоптимально ...

Строчу свою функцию ...

Latuk

Дата: 09.09.2005 10:47:05

Простым перебором-тупо но прозрачно

Public Function СбВсКол(ДатаНач As Date, ДатаКон As Date) As Integer

Dim DayOfWeek As Integer, Дата As Date, СбВсCount As Integer

    Дата = ДатаНач
    
    Do While Дата <= ДатаКон
        DayOfWeek = DatePart("w", Дата, vbMonday)
        If DayOfWeek = 6 Or DayOfWeek = 7 Then СбВсCount = СбВсCount + 1
        Дата = Дата + 1
    Loop
    
    СбВсКол = СбВсCount

End Function

в принципе можно подсчитать число полных недель
и проверить первую и последнюю на предмет поподания в них суб/вс

'Количество недель
Debug.Print DateDiff("ww", ДатаНач, ДатаКон, vbMonday)
'Первая неделя началась
Debug.Print DatePart("w", ДатаНач, vbMonday)
'последняя неделя закончилась
Debug.Print DatePart("w", ДатаКон, vbMonday)

Хотя в жизни праздники все гораздо запутанней и не ограничиваются одними уикендами
встречаются всякие другие праздники
и что уж совсем не предугадаешь постановления правительства о переносу рабочих дней
я обычно табличку завожу ОсобыеДни

Alex112

Дата: 09.09.2005 11:31:37

Вот что получилось без использования цикла:

Public Function HDays(ByVal St As Date, ByVal En As Date) As Long
'Возвращает количество Сб. и Вс. между St и En
    
    Dim StWd As Integer
    Dim EnWd As Integer
    Dim Hd As Long
    
    StWd = WeekDay(St, vbMonday)
    EnWd = WeekDay(En, vbMonday)
    
    Hd = DateDiff("ww", St, En, vbMonday)
   
    If Hd = 0 Then 'Период в не длинней одной недели (7 дней)
        If StWd = 6 Then Hd = Hd + 1
        If StWd = 7 Then Hd = Hd + 1
        If EnWd = 6 Then Hd = Hd + 1
        If EnWd = 7 Then Hd = Hd + 1
    Else
        Hd = (Hd - 1) * 2
        If StWd <= 6 Then Hd = Hd + 2
        If StWd = 7 Then Hd = Hd + 1
        If EnWd = 6 Then Hd = Hd + 1
        If EnWd = 7 Then Hd = Hd + 2
    End If
    
    HDays = Hd

End Function

Беглое тестирование показало, что, вроде, работает правильно ...

2 Latuk

Мне эту функцию нужно натравить на таблицу с более чем 20 000 записями: St и En в одной строке может быть более года. Поэтому цикл по периоду внутри функции, ну никак ...

глупыйглупый

Дата: 09.09.2005 11:33:30

у меня по глупому получилось так

Function FoolishCountHoliday(startDate As Date, lastDate As Date) As Long
  Dim uu As Long, dd As Long
  
  uu = Weekday(startDate, vbSaturday)  ', vbFriday) ', vbMonday)
  
  If uu > 2& Then
    uu = 0&
  End If
  
  dd = DateDiff("ww", startDate, lastDate, vbMonday)
  FoolishCountHoliday = dd + dd - uu
End Function

глупыйглупый

Дата: 09.09.2005 11:35:21

т.е., типа стартовый день в расчет не включен.

Alex112

Дата: 09.09.2005 11:36:58

2 глупыйглупый

Спасибо! Щас протестируем :-) ...

Alex112

Дата: 09.09.2005 11:47:42

2 глупыйглупый

У меня на:

    N = FoolishCountHoliday(#9/7/2005#, #9/10/2005#)

дает N=0 :-( ... Субботу не считает ...

глупыйглупый

Дата: 09.09.2005 11:57:35

ну так ты прав был. хвост тоже надо учитывать.

Function FoolishCountHoliday(startDate As Date, lastDate As Date) As Long
'расчет выходных между двумя датами
  Dim uu As Long, dd As Long, kk As Long
  
  uu = Weekday(startDate, vbSaturday)
  kk = Weekday(lastDate, vbSaturday)
  If uu > 2& Then
    uu = 0&
  End If
  If kk > 2 Then
    kk = 0
  End If
  
  dd = DateDiff("ww", startDate, lastDate, vbMonday)
  FoolishCountHoliday = dd + dd - uu + kk
End Function