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

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

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

Простенько и с учетом високосности, лучшим приближением будет делить на 365.25

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


Или:

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


Или:

=DateDiff("m",BDate, DATE)\12 & " и " & DateDiff("m",BDate,DATE) MOD 12 & " мес."

Слово "год" или "года" или "лет" сами добавите, если нужно.




Ещё вариант:

Public Function AgeByDateOfBirth(vDateOfBirth As Variant, _
                Optional vForDate = Null) As Long
'es 06.12.2012 - LE 18.01.2001 v002
'Возвращает возраст на текущую дату (или на конкретную дату)
'   при ошибке или пустом аргументе DateOfBirth возвращает -1 (МИНУС ОДИН)
'--------------------------------------------------------------------------
'?AgeByDateOfBirth(#6/12/1987#, , -1)
'--------------------------------------------------------------------------
'Аргументы:
'   DateOfBirth       -  Дата Рождения
'   varForDate        -  Дата на которую рассчитать (по умолчанию = сегодня)
'   boolReturnSrting  -  Вергуть результат
'--------------------------------------------------------------------------
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. 19.01.2021
Рейтинг@Mail.ru