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

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

По материалам:
http://www.cyberforum.ru/ms-access/thread2418741.html
https://www.cyberforum.ru/ms-access/thread2595202.html

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

Возраст: Round((DATE()-[ДАТА_Рождения])/365,25; 1)

Или без дробной части:

Возраст: Fix((DATE()-[ДАТА_Рождения])/365,25)


Или:

=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 v001
'Возвращает возраст строкой на текущую дату (или на конкретную дату)
'   строкой : "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
    
    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

    AgeStr = lAge & sVal
    
AgeStr_Bye:
    Exit Function

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