Понедельник, 06.05.2024, 03:34
Приветствую Вас Гость | RSS
Категории раздела
Вход на сайт
Поиск
Статистика

Онлайн всего: 1
Гостей: 1
Пользователей: 0

MS Access - разработка баз под заказ

Каталог статей


Количество дней в месяце, последний день месяца, високосный год и т.д.

Нет-нет, но на форуме периодически появляются вопросы типа "Как определить количество дней в заданном месяце?", "Как найти последний день месяца?" и т.п. Эти проблемы давно решены, но вопросы возникают снова. И я решил написать короткую статью на эту тему. Использованы решения из книг и с сайтов Андрея Митина и SQL.RU

В.И. Король "Visual Basic 6.0, Visual Basic for Application 6.0" - последний день месяца
Function LastDateOfMonth(dCurdate As Date) As Date
 LastDateOfMonth = DateSerial(Year(dCurdate), Month(dCurdate)+1,0)
end function

Программист-Любитель - последний день месяца
Public Function LastDayOfMonth(dtDate As Date)
 LastDayOfMonth = DateAdd("d", -1, DateSerial(Year(dtDate), Month(dtDate) + 1, 1))
End Function

Анатолий (Киев) - количество дней в месяце
Function DaysInMonthA(dCurdate As Date) As Integer
 DaysInMonthA = DateSerial(Year(dCurdate), Month(dCurdate) + 1, 1) - _
 DateSerial(Year(dCurdate), Month(dCurdate), 1)
end function

V.Kim - количество дней в месяце
Function DaysInMonth(dCurdate As Date) As Integer
 DaysInMonth = DateDiff("d", DateSerial(Year(dCurdate), Month(dCurdate), 1), _
 DateSerial(Year(dCurdate), Month(dCurdate) + 1, 1))
end function

Владимр Саныч - количество дней в месяце (на основе предложения В.И. Короля)
Function DaysInMonthB(dCurdate As Date) As Integer
 DaysInMonthB = Day(DateSerial(Year(dCurdate), Month(dCurdate) + 1, 0))
end function

Joss - високосный год
Function fnLongYear(iYear As Integer) As Boolean
 If DateSerial(iYear, 3, 1) - DateSerial(iYear, 2, 1) = 29 then
 fnLongYear = True
 else
 fnLongYear = False
 End If 
end function

АлексейЕ - високосный год
Function LeapYear(intYear As Integer) As Boolean
 LeapYear = (intYear Mod 4 = 0 And (Not intYear Mod 100 = 0 Xor intYear Mod 400 = 0))
End Function 

Dr.Livsi - определение количества рабочих и выходных дней
Public Function WorkdaysInMonth(ByVal dCurdate As Date, Optional ByVal Workday As Boolean = True) As Integer
'функция определения количества рабочих и выходных дней в заданном месяце
'параметр Workday может принимать 2 значения:
'True - в этом случае подсчитывается количество рабочих дней в заданном месяце (по умолчанию)
'False - в этом случае подсчтиывается количество выходных дней в заданном месяце
Dim MyDate As Date
Dim i, intMyWeekend, intMyWorkday As Integer

For i = 1 To DaysInMonthA(dCurdate)
 MyDate = CDate(i & "." & CStr(Month(dCurdate)) & "." & CStr(Year(dCurdate)))
 If ((WeekdayName(Weekday(MyDate), True, 1) = "Сб") Or (WeekdayName(Weekday(MyDate), True, 1) = "Вс")) Then
 intMyWeekend = intMyWeekend + 1
 Else
 intMyWorkday = intMyWorkday + 1
 End If
Next i

If Workday = True Then
 WorkdaysInMonth = intMyWorkday
Else
 WorkdaysInMonth = intMyWeekend
End If

End Function
Примечание: не учитываются праздники и переносы.

V.Kim - для коллекции
Enum FirstWeekMethod
 UseSystem = vbUseSystem '= 0 ' Use NLS API setting.
 FirstJan1 = vbFirstJan1 '= 1 'Start with week in which January 1 occurs (default for Format function).
 FirstFourDays = vbFirstFourDays '= 2 'Start with the first week that has at least four days in the year.
 FirstFullWeek = vbFirstFullWeek '= 3 'Start with the first full week of the year.
End Enum

Function WeekNumber(Dt As Date, Optional FirstWeekAs As FirstWeekMethod =2) As Long
 WeekNumber = Format(Dt, "ww", , FirstWeekAs)
End Function


Примечание от Alex    
а у меня Format "ww" направильно работает (в 1 и 53 неделе бывает меньше 7 дней).
Правильно получилось с DatePart:

Function WeekNumber%(vDate, _
 Optional nFirstDayAs = vbMonday, _
 Optional nFirstWeekAs = vbFirstFourDays)
 
 WeekNumber = DatePart("ww", vDate, nFirstDayAs, nFirstWeekAs)
End Function

    
Эти функции можно доработать по своему желанию и получить то, что хотите.

Категория: Мои статьи | Добавил: sonni-dim (04.07.2019)
Просмотров: 157 | Теги: год, месяц | Рейтинг: 0.0/0
Всего комментариев: 0
avatar