Форумы HiProg.com - MS ACCESS, VBA, VB

 

Ответить на сообщение

Вернуться к теме

Вы отвечаете на сообщение:

ник: Дядя Федор
Вот что получилось
'ищет первый рабочий день, ближайший к cd / сначала раньше, если нет - позже
'но обязательно в том же месяце


'ДВА ВАРИАНТА-  1:
Public Function Fworkday(cd As Date) As Date
Dim rst As DAO.Recordset
Const SQLDATE As String = "\#mm\/dd\/yyyy\#"
Dim strsql As String, strCrit As String, firstday As Date, lastday As Date
firstday = DateSerial(Year(cd), Month(cd), 1)
lastday = DateSerial(Year(cd), Month(cd) + 1, 0)
strCrit = "between " & Format$(firstday, SQLDATE) & " AND " & Format$(lastday, SQLDATE)
strsql = "select [DataTabCal],[BlnDay] from TblTabCal where DataTabCal " & strCrit
Set rst = CurrentDb.OpenRecordset(strsql)
With rst
 .FindFirst "[DataTabCal]=" & Format$(cd, SQLDATE)
 If !BlnDay Then
   Fworkday = cd
   Exit Function
 End If
End With
If (Month(DMax("[DataTabCal]", "[TblTabCal]", "[BlnDay] AND ([DataTabCal] < " & Format$(cd, SQLDATE) & ")"))) = Month(cd) Then
    Fworkday = DMax("[DataTabCal]", "[TblTabCal]", "[BlnDay] AND [DataTabCal] <" & Format$(cd, SQLDATE))
Else
    Fworkday = DMin("[DataTabCal]", "[TblTabCal]", "[BlnDay] AND [DataTabCal] >" & Format$(cd, SQLDATE))
End If
End Function
'2-й ВАРИАНТ
Public Function Fworkdays(cd As Date) As Date
'ищет пурвый рабочий день, ближайший к cd / сначала раньше, если нет - позже
'но обязательно в том же месяце
Dim rst As DAO.Recordset
Dim bb As Variant
Const SQLDATE As String = "\#mm\/dd\/yyyy\#"
Dim strsql As String, firstday As String, lastday As String
firstday = Format$(DateSerial(Year(cd), Month(cd), 1), SQLDATE)
lastday = Format$(DateSerial(Year(cd), Month(cd) + 1, 0), SQLDATE)
strsql = "select [DataTabCal],[BlnDay] from TblTabCal where DataTabCal " & _
"between " & firstday & " AND " & lastday
Set rst = CurrentDb.OpenRecordset(strsql)
With rst
 .FindFirst "[DataTabCal]=" & Format$(cd, SQLDATE)
 If !BlnDay Then
   Fworkdays = cd
   Exit Function
 Else
   bb = .Bookmark
   Do
     If !BlnDay Then
        Fworkdays = !DataTabCal
        Exit Function
     End If
     .MovePrevious
   Loop Until .BOF
  .Bookmark = bb
  Do
     If !BlnDay Then
        Fworkdays = !DataTabCal
        Exit Function
     End If
     .MoveNext
  Loop Until .EOF
 End If
End With
End Function


ВАРИАНТ 2 в 2 раза быстрее
Будет использоваться в запросах по построению плана выпуска


Ваше имя:

Пароль:
Цитировать: [quote][/quote] Код: [code][/code]
Жирный: [b][/b] Наклонный: [i][/i]
URL: [url][/url] 

Сообщение:

 Размер файла не более 50 Кбт. Большие файлы можно размещать на www.slil.ru

Прикрепить:

 

Для вставки смайлов в текст щелкните по значку.