|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | дана таблица tb_hdays
hdatefrom hdatetill Коммент
01.05.2009 03.05.2009
09.05.2009 10.05.2009
28.06.2009 29.06.2009
|
и функция, которая,  глядя в эту таблицу, возвращает  следующую рабочую дату. Рабочая дата - это не праздничные,описанные в tb_hdays и не суббота и воскресенье (хотя я бы загнал и их в эту таблицу, но таково было желание жены  )
Public Function VDate(dt As Date, Optional turn = 1) As Date
Dim dd As Date, dr As Date, dp&
On Error Resume Next
If Nz(dt, 0) = 0 Then Exit Function
'-- праздник?
If turn = 1 Then
dd = DLookup("[hdatetill]", "tb_hdays", "" & Format(dt, "\#mm\/dd\/yyyy\#") & " between [hdatefrom] and [hdatetill]")
Else
dd = DLookup("[hdatefrom]", "tb_hdays", "" & Format(dt, "\#mm\/dd\/yyyy\#") & " between [hdatefrom] and [hdatetill]")
End If
If Nz(dd, 0) <> 0 Then '-- ой, таки праздник!
dd = DateAdd("d", 1 * turn, dd)
Else
dd = dt
End If
'--выходной?
dp = DatePart("w", dd, vbUseSystemDayOfWeek)
If dp = 6 Then '--суббота
If turn = 1 Then
dd = DateAdd("d", 2, dd)
Else
dd = DateAdd("d", -1, dd)
End If
ElseIf dp = 7 Then '--воскресенье
If turn = 1 Then
dd = DateAdd("d", 1, dd)
Else
dd = DateAdd("d", -2, dd)
End If
End If
'--а вдруг еще?!
If turn = 1 Then
dr = DLookup("[hdatetill]", "tb_hdays", "" & Format(dd, "\#mm\/dd\/yyyy\#") & " between [hdatefrom] and [hdatetill]")
Else
dr = DLookup("[hdatefrom]", "tb_hdays", "" & Format(dd, "\#mm\/dd\/yyyy\#") & " between [hdatefrom] and [hdatetill]")
End If
If Nz(dr, 0) <> 0 Then '-- ой, таки опять праздник!
dd = VDate(DateAdd("d", 1 * turn, dr))
End If
VDate = dd
End Function
|
опция turn - это направление определения след. рабочей даты. если turn=-1, то в обратном направлении, т.е. countdown, по умолчанию - вперёд 
функция работает рекурсивно.
использую в запросе такого вида
SELECT tb_projects.pname, tb_jobs.jname, VDate(DateAdd("d",-[n_a_max],[Создание]),-1) AS СрокиСбор, VDate(DateAdd("d",-[n_c_max],[Проверка]),-1) AS Создание, VDate(DateAdd("d",-[n_4_max],[СдатьВПечать]),-1) AS Проверка, VDate(DateAdd("d",-([n_p_max]),[datefrom])) AS СдатьВПечать, [datefrom] & " - " & [datetill] AS СрокиРассылка, tb_work.pid, tb_work.jid
FROM tb_projects INNER JOIN (tb_jobs INNER JOIN tb_work ON tb_jobs.id = tb_work.jid) ON tb_projects.id = tb_work.pid
WHERE (((Month([datefrom]))=[Введите номер месяца]) AND ((Month([datetill]))=[Введите номер месяца]));
|
для построения графика выполнения проекта
вот... ну , если кому интересно, то можете дорабатывать, использовать  | |
| |
| |
| |
 14 Кб. |
|
| | Наверное стоит несколько изменить таблицу исключений, для увеличения функциональности.
Позволит хранить и переносы рабочих дней по Постановлениям правительства.
PS. У нас опять новые веяния с праздниками, чего то опять изменили. | |
| |
| |
| |
|
|
| | та да :) я писал об этом
лиха беда начало ;) | |
| |
| |
| |
11 Кб. |
|
| | Как-то так:
Public Function funIsWorkDay(datDay As Date) As Boolean
Dim strFiltr As String
Dim Except As Integer
strFiltr = "DayExc=" & Day(datDay) & " AND MonthExc=" & Month(datDay) & " AND YearStart<=" & Year(datDay) & " AND (YearEnd>=" & Year(datDay) & " Or YearEnd=0)"
Except = Nz(DLookup("WorkDay", "tblException", strFiltr), 2)
Select Case Except
Case Is = 2
funIsWorkDay = DatePart("w", datDay, vbUseSystemDayOfWeek) < 6
Case Else
funIsWorkDay = Except
End Select
End Function
Public Function funNextWorkDay(ByVal datDay As Date, Optional blnForvard As Boolean = True, Optional lngShift As Long = 0) As Date
Dim lngStep As Long
If blnForvard Then lngStep = 1 Else lngStep = -1
datDay = datDay + lngStep + lngShift
Do Until funIsWorkDay(datDay)
datDay = datDay + lngStep
Loop
funNextWorkDay = datDay
End Function
|
Календаря бумажного нет. Сильно тестить лень. | |
| |
| |
| |
|
|
| | во! не оскудеет Земля на богатырей  | |
| |
| |
| |
|
|
| | В том богатыре полтора метра, вместе с кепкой. 
Забыл.
Создание индекса по 4 полям в таблице исключений увеличит скорость процентов на 10. | |
| |
| |
HiProg.com - Технологии программирования
|
