Аналог функции ЧИСТРАБДНИ

[Mint86]

Коллеги, нужен макрос (или формула если это возможно) аналог функции ЧИСТРАБДНИ из надстройки "Пакет анализа". Здесь описание данной функции.

[doober]

тестируйте,вроди бы работает

Private Sub CommandButton1_Click()

f = What_Rab("1.05.2010", "29.05.2010")
f 1= What_Wyh("1.05.2010", "29.05.2010")
End Sub
Function What_Rab(date_st As Date, date_en As Date) As Integer
  Dim rez, rezult As String
  Dim dd As Integer, poz As Integer, MyWeekDay As Integer, Period As Double
  Period = (Format(date_en, "#")) - (Format(date_st, "#"))+ 1
   Dim d As Double
   Dim Md As Long: Dim mm As Long: Dim n As Long
    MyWeekDay = Weekday(DateSerial(Year(date_st), Month(date_st), Day(date_st)), vbMonday)
 For n = MyWeekDay To Period + MyWeekDay - 1
   mm = n: rez = ""
 Do While mm >= 7
      Md = mm Mod 7
      mm = Int(mm / 7)
      rez = Md & rez
     Loop
 rezu = mm & rez
poz = (Mid(rezu, Len(rezu), 1))
 Select Case poz
 Case 0, 6
  dd = dd + 1
 End Select
Next
What_Rab = Period - dd
End Function



Function What_Wyh(date_st As Date, date_en As Date) As Integer
  Dim rez, rezult As String
  Dim dd As Integer, poz As Integer, MyWeekDay As Integer, Period As Double
  Period = (Format(date_en, "#")) - (Format(date_st, "#"))+ 1
   Dim d As Double
   Dim Md As Long: Dim mm As Long: Dim n As Long
    MyWeekDay = Weekday(DateSerial(Year(date_st), Month(date_st), Day(date_st)), vbMonday)
 For n = MyWeekDay To Period + MyWeekDay - 1
   mm = n: rez = ""
 Do While mm >= 7
      Md = mm Mod 7
      mm = Int(mm / 7)
      rez = Md & rez
     Loop
 rezu = mm & rez
poz = (Mid(rezu, Len(rezu), 1))
 Select Case poz
 Case 0, 6
  dd = dd + 1
 End Select
Next
What_Wyh = dd
End Function

Строку подкорректировал Period = (Format(date_en, "#")) - (Format(date_st, "#"))+ 1

[Mint86]

Работает, но надо бы добавить возможность учета и праздничных дней...

[doober]

Раставте правильно праздники

 Dim Holi As Collection
 
 Sub Holi_Add()
Set Holi = New Collection
Holi.Add "03.05.2010"
Holi.Add "10.05.2010"
'дальше сами
End Sub
Function Holiday(date_st As Date, date_en As Date) As Integer
  Holiday = 0
  Dim dd As Integer, poz As Integer, MyWeekDay As Integer, Period As Double
    Period = (Format(date_en - date_st, "#"))
    For n = 0 To Period
   Dim g
    
For Each g In Holi

If CDate(g) = date_st + n Then
Holiday = Holiday + 1
End If
Next g

  Next
End Function

Private Sub CommandButton1_Click()

f = What_Rab("1.05.2010", "29.05.2010")
f1 = What_Wyh("1.05.2010", "29.05.2010")
End Sub
Function What_Rab(date_st As Date, date_en As Date) As Integer
 Holi_Add

  Dim rez, rezult As String
  Dim dd As Integer, poz As Integer, MyWeekDay As Integer, Period As Double
    Period = (Format(date_en - date_st, "#")) + 1
  
  Period = (Format(date_en - date_st, "#")) + 1
   Dim d As Double
   Dim Md As Long: Dim mm As Long: Dim n As Long
    MyWeekDay = Weekday(DateSerial(Year(date_st), Month(date_st), Day(date_st)), vbMonday)
 For n = MyWeekDay To Period + MyWeekDay - 1
   mm = n: rez = ""
 Do While mm >= 7
      Md = mm Mod 7
      mm = Int(mm / 7)
      rez = Md & rez
     Loop
 rezu = mm & rez
poz = (Mid(rezu, Len(rezu), 1))
 Select Case poz
 Case 0, 6
  dd = dd + 1
 End Select
Next
What_Rab = Period - dd - Holiday(date_st, date_en)
End Function



Function What_Wyh(date_st As Date, date_en As Date) As Integer
 Holi_Add
  Dim rez, rezult As String
  Dim dd As Integer, poz As Integer, MyWeekDay As Integer, Period As Double
  Period = (Format(date_en - date_st, "#")) + 1
   Dim d As Double
   Dim Md As Long: Dim mm As Long: Dim n As Long
    MyWeekDay = Weekday(DateSerial(Year(date_st), Month(date_st), Day(date_st)), vbMonday)
 For n = MyWeekDay To Period + MyWeekDay - 1
   mm = n: rez = ""
 Do While mm >= 7
      Md = mm Mod 7
      mm = Int(mm / 7)
      rez = Md & rez
     Loop
 rezu = mm & rez
poz = (Mid(rezu, Len(rezu), 1))
 Select Case poz
 Case 0, 6
  dd = dd + 1
 End Select
Next
What_Wyh = dd + Holiday(date_st, date_en)
End Function

[IgorGO]

или вот формула для определения количества выходных:

=ЦЕЛОЕ((B1-A1+1)/7-(ДЕНЬНЕД(B1;2)<ДЕНЬНЕД(A1;2))*1)*2+(ДЕНЬНЕД(A1;2)<6)*(ДЕНЬНЕД(B1;2)<ДЕНЬНЕД(A1;2))*2+(ДЕНЬНЕД(A1;2)>5)*(8-ДЕНЬНЕД(A1;2))+(ДЕНЬНЕД(B1;2)>5)*(ДЕНЬНЕД(B1;2)-5)+СУММПРОИЗВ((праздники>=A1)*(праздники<=B1-(ДЕНЬНЕД(B1;2)-5)*(ДЕНЬНЕД(B1;2)>5)))

понятно, рабочих будет "всех" минус "выходных".
Подойдет, как для расчетов, так и для тестирования функции, которую doober написал. Интересно сколько будет отличий в определении количества этих самых дней.
именованый диапазон "праздники" - надо бы дополнить и поправить под местное законодательство...

[doober]

Да .С праздниками просквозил.Надо так

 Sub Holi_Add()
Set Holi = New Collection
Holi.Add "01.05.2010"
Holi.Add "02.05.2010"
Holi.Add "9.05.2010"
'дальше сами
End Sub

[IgorGO]

я у себя уже ошибку нашел:
=ЦЕЛОЕ((B1-A1+1)/7-(ДЕНЬНЕД(B1;2)<ДЕНЬНЕД(A1;2))*1)*2. ..
=ЦЕЛОЕ((B1-A1+1)/7-(ДЕНЬНЕД(B1;2)<=ДЕНЬНЕД(A1;2))*1)*2...
doober, с 25 апр. по 9 мая - у нас разные результаты.
у меня 7 выходных, 8 рабочих.
у тебя ровно наоборот: 8 выходных, 7 рабочих. Т.к. функции независимые - значит в обоих по ошибке.

[Mint86]

IgorGO, формула почему-то дает с 01.05.2010 по 31.05.2010 гг. 8 выходных без праздников. А макрос doober 10 выходных. Правильно 10 выходных (ручной подсчет) или для проверки с использованием функции чистрабдни =ДЕНЬ(ДАТА(2010;5;31))-ЧИСТРАБДНИ(ДАТА(2010;5;1);ДАТА(2010 ;5;31))

doober, а можешь изменить код чтобы праздничные дни брались из диапазона ячеек?

[Mint86]

doober, в коде надо сделать проверку на день недели праздничного дня. Иначе с 01.05.2010 по 31.05.2010 с праздниками
Holi.Add "01.05.2010"
Holi.Add "02.05.2010"
Holi.Add "9.05.2010"
получается что выходных дней 13 а на самом деле 02.05.2010 года уже выходной его в расчет брать не надо.

Проверка сделана с помощью той же функции чистрабдни и вручную.

[IgorGO]

согласен, опять ошибка.
запишите в С1 вот это:

=СУММПРОИЗВ((ДЕНЬНЕД(A1+СТРОКА(ДВССЫЛ("1:"&B1-A1+1))-1;2)>5)*1)+СУММПРОИЗВ((праздники>=A1)*(праздники<=B1-(ДЕНЬНЕД(B1;2)-5)*(ДЕНЬНЕД(B1;2)>5)))

у данной формулы, по сравнению с предыдущей, есть несколько преимуществ:
1. правильно считает
2. намного короче (это очень существенно для меня лично)
3. простой алгоритм
и один недостаток:
та формула была сделана на логике, и подсчет осуществлялся за счет математических формул, а эта на тупом переборе всех дат входящих в интервал с проверкой - а не суббота ли или воскресенье данная дата.