Небольшое примечание: если в качестве входного параметра указано (Optional dteDate As Date), то вызов функции можно осуществлять как НазваниеФункции() - то есть можно оставлять пустые скобки. Например MsgBox FirstOfQuarter() Список функцийОпределение первого дня текущего квартала| Код |
Function FirstOfQuarter(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfQuarter = DateSerial(Year(dteDate), Int((Month(dteDate) - 1) / 3) * 3 + 1, 1)
End Function
|
| Код |
Function LastOfQuarter(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfQuarter = DateSerial(Year(Date), Int((Month(Date) - 1) / 3) * 3 + 4, 0)
End Function
|
| Код |
Function FirstOfMonth(Optional dteDate As Date) As Date
'если параметр dteDate = 0 то для вычисления берется текущая дата
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfMonth = DateSerial(Year(dteDate), Month(dteDate), 1)
End Function
|
| Код |
Function LastOfMonth(Optional dteDate As Date) As Date
'если параметр dteDate = 0 то для вычисления берется текущая дата
If CLng(dteDate) = 0 Then
dteDate = Date
End If
'Ищется первый день следующего месяца, и вычитается один день
LastOfMonth = DateSerial(Year(dteDate), Month(dteDate) + 1, 1) - 1
End Function
|
| Код |
Function FirstOfNextMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfNextMonth = DateSerial(Year(dteDate), Month(dteDate) + 1, 1)
End Function
|
| Код |
Function LastOfNextMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfNextMonth = DateSerial(Year(dteDate), Month(dteDate) + 2, 0)
End Function
|
| Код |
Function FirstOfPreviousMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
FirstOfPreviousMonth = DateSerial(Year(dteDate), Month(dteDate) - 1, 1)
End Function
|
| Код |
Function LastOfPreviousMonth(Optional dteDate As Date) As Date
If CLng(dteDate) = 0 Then
dteDate = Date
End If
LastOfPreviousMonth = DateSerial(Year(dteDate), Month(dteDate), 0)
End Function
|
| Код |
Function StartOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant '
'Пример: MsgBox StartOfWeek(Date)
If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week.
StartOfWeek = D - Weekday(D) + 1
Else
StartOfWeek = D - Weekday(D, FirstWeekday) + 1
End If
End Function
|
| Код |
Function EndOfWeek(D As Variant, Optional FirstWeekday As Integer) As Variant
'Пример: MsgBox EndOfWeek(Date)
If IsMissing(FirstWeekday) Then 'Sunday is the assumed first day of week.
EndOfWeek = D - Weekday(D) + 7
Else
EndOfWeek = D - Weekday(D, FirstWeekday) + 7
End If
End Function
|
| Код |
Function DayOfYear(Optional dteDate As Date) As Long
If CLng(dteDate) = 0 Then
dteDate = Date
End If
DayOfYear = Abs(DateDiff("d", dteDate, DateSerial(Year(dteDate) - 1, 12, 31)))
End Function
|
Данная функция определяет: рабочий день или нет Примечание: Дни с понедельника по пятницу считаются рабочими | Код |
Function IsWorkday(Optional dteDate As Date) As Boolean
If CLng(dteDate) = 0 Then
dteDate = Date
End If
Select Case Weekday(dteDate)
Case vbMonday To vbFriday
IsWorkday = True
Case Else
IsWorkday = False
End Select
End Function
|
| Код |
Function LastBusDay(D As Variant) As Variant
'Пример: MsgBox LastBusDay(Date)
Dim D2 As Variant
If VarType(D) <> 7 Then
LastBusDay = Null
Else
D2 = DateSerial(Year(D), Month(D) + 1, 0)
Do While Weekday(D2) = 1 Or Weekday(D2) = 7
D2 = D2 - 1
Loop
LastBusDay = D2
End If
End Function
|
| Код |
Function CalcAge(dteBirthdate As Date) As Long
'В качестве параметра dteBirthdate необходимо задать дату рождения
'Пример: MsgBox CalcAge("09/03/75")
Dim lngAge As Long
If Not IsDate(dteBirthdate) Then
dteBirthdate = Date
End If
'Проверить, чтобы в качестве входного параметра не была задана дата в будущем
If dteBirthdate > Date Then
dteBirthdate = Date
End If
'Подсчет разницы в годях между текущей датой и датой рождения
lngAge = DateDiff("yyyy", dteBirthdate, Date)
'Вычитается один год, если в этом году дня рождения еще не было
If DateSerial(Year(Date), Month(dteBirthdate), Day(dteBirthdate)) > Date Then
lngAge = lngAge - 1
End If
CalcAge = lngAge
End Function
|
Естественно, что значение Bdate должно быть меньше параметра DateToday | Код |
Function Age(Bdate, DateToday) As Integer
If Month(DateToday) < Month(Bdate) Or (Month(DateToday) = Month(Bdate) And Day(DateToday) < Day(Bdate)) Then
Age = Year(DateToday) - Year(Bdate) - 1
Else
Age = Year(DateToday) - Year(Bdate)
End If
End Function
|
| Код |
Function LeapYear(YYYY As Integer) As Integer
'Функция возвращает -1, если указанный входной параметр (год) является високосным
'Пример: MsgBox LeapYear(1996)
LeapYear = YYYY Mod 4 = 0 And (YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0)
End Function
Function LeapYear2(YYYY As Integer) As Integer
'Функция возвращает -1, если указанный входной параметр (год) является високосным
'Пример: MsgBox LeapYear(1996)
LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2
End Function
Function IsLeapYear(DateIn As Date) As Boolean
'Функция возвращает True, если год в указанной дате является високосным
'Проверка: MsgBox IsLeapYear("01/01/00")
If IsDate("29/02/" & Format(DateIn, "yyyy")) = True Then
IsLeapYear = True
End If
End Function
|
|
Примеры работы с датами 
Загрузка ...
