VBA, MS Access MS Access в примерах

Возраст на конкретную или текущую дату

Простенько и с учетом високосности, лучшим приближением будет делить на 365.25, а астрономы говорят, что точнее 365,2475.

Выражение в запросе:


    Age: IIf([пцтДатаРождения]>0;(Date()-[пцтДатаРождения])\365,2475;-1)


Или:


    =DateDiff("yyyy";BDate;DATE())+(Format(DATE();"mmdd")<Format(BDate;"mmdd"))


Или:

=DateDiff("yyyy";[Дата рождения];Date())+(Format([Дата рождения];"mmdd")>Format(Date();"mmdd"))


Или SQL:

SELECT Фамилия, ДатаРождения
FROM ФДР
WHERE (((DateDiff("yyyy",[ДатаРождения],DATE())+(Format([ДатаРождения],"mmdd")>Format(DATE();"mmdd")))=18))


Ввод даты как параметра запроса (в конструкторе)
Возраст: DateDiff("yyyy";[BORN];[Введите дату])+(Format([BORN];"mmdd")>Format([Введите дату];"mmdd"))

Ещё вариант:

Public Function AgeByDateOfBirth(vDateOfBirth As Variant, _
                Optional vForDate = Null) As Long
'es 06.12.2012 - LE 31.05.2021 v003
'Возвращает возраст на текущую дату (или на конкретную дату)
'   при ошибке или пустом аргументе DateOfBirth возвращает -1 (МИНУС ОДИН)
'--------------------------------------------------------------------------
'?AgeByDateOfBirth(#6/12/1987#)
'--------------------------------------------------------------------------
'Аргументы:
'   vDateOfBirth    -  Дата Рождения
'   vForDate        -  Дата на которую рассчитать (по умолчанию = сегодня)
'--------------------------------------------------------------------------
Dim iVal As Integer
Dim sVal As String
On Error GoTo AgeByDateOfBirth_Err
'Проверяем аргументы
    If IsNull(vForDate) Then vForDate = Date

'Разница в годах между датой рождения и датой на которую
    AgeByDateOfBirth = DateDiff("yyyy", vDateOfBirth, vForDate)

'Вычитается один год, если в этом году дня рождения еще не было
    If DateSerial(Year(vForDate), Month(vDateOfBirth), Day(vDateOfBirth)) > vForDate Then
        AgeByDateOfBirth = AgeByDateOfBirth - 1
    End If
    AgeByDateOfBirth = AgeByDateOfBirth & sVal
    
AgeByDateOfBirth_Bye:
    Exit Function

AgeByDateOfBirth_Err:
    AgeByDateOfBirth = -1
    Err.Clear
    Resume AgeByDateOfBirth_Bye
End Function


Строкой:

Public Function AgeStr(vDateOfBirth As Variant, Optional vForDate = Null) As String
'es 19.01.2001 LE 01.04.2024 v003
'Возвращает возраст строкой на текущую дату (или на конкретную дату) строкой : "28 лет"; "41 год"; "3 года" ...
'   при пустом аргументе DateOfBirth возвращает пустую строку, а при ошибке возвращает номер ошибки
'--------------------------------------------------------------------------
'?AgeStr(#6/12/1987#)
'--------------------------------------------------------------------------
'Аргументы:
'   vDateOfBirth  -  Дата Рождения
'   vForDate      -  Дата на которую рассчитать (по умолчанию = сегодня)
'--------------------------------------------------------------------------
Dim iVal As Integer, lAge As Long
Dim sVal As String
On Error GoTo AgeStr_Err
'Проверяем аргументы
    If IsNull(vForDate) Then vForDate = Date

'Разница в годах между датой рождения и датой на которую
    lAge = DateDiff("yyyy", vDateOfBirth, vForDate)

'Вычитается один год, если в этом году дня рождения еще не было
    If DateSerial(Year(vForDate), Month(vDateOfBirth), Day(vDateOfBirth)) > vForDate Then
        lAge = lAge - 1
    End If
    
    If 4 < lAge < 21 Then 
        sVal = " лет"
    Else
        iVal = lAge Mod 10
        Select Case iVal
            Case 1: sVal = " год"
            Case 2, 3, 4: sVal = " года"
            Case 5, 6, 7, 8, 9, 0: sVal = " лет"
        End Select
    End If

    AgeStr = lAge & sVal
    
AgeStr_Bye:
    Exit Function

AgeStr_Err:
    AgeStr = "Err" & Err.Number
    Err.Clear
    Resume AgeStr_Bye
End Function
Назад ToTop
L.E. 12.10.2024
Рейтинг@Mail.ru