Как рассчитать возраст на дату до 1 января 1900 года в Excel?
В Excel невозможно ввести и корректно обработать даты, предшествующие 1 января 1900 года. Если вам нужно рассчитать возраст человека, родившегося и умершего до этой даты, стандартные средства Excel, как правило, не обеспечат точного результата. Однако в этой статье описан приём, позволяющий корректно вычислить такой возраст в Excel.
Расчёт возраста до 1/1/1900 с помощью VBA
Расчёт возраста по дате рождения с помощью Kutools для Excel 
Расчёт возраста до 1/1/1900 с помощью VBA
Приведённый ниже код VBA позволит вам быстро рассчитать возраст на дату до 1 января 1900 года.
1. Выберите пустую ячейку и введите дату рождения человека, затем — в другой ячейке — укажите текущую дату или дату смерти, в зависимости от ваших задач. См. снимок экрана:
2. Затем нажмите клавиши Alt + F11, чтобы открыть окно Microsoft Visual Basic для приложений.
3. Нажмите Вставка > Модуль и вставьте приведённый ниже код VBA в новое окно Модуля.
VBA: расчёт возраста до 1/1/1900
Public Function AgeFunc(SDate As Variant, EDate As Variant) As Long
'UpdatebyExtendOffice20160429
Dim xSMonth As Integer
Dim xSDay As Integer
Dim xSYear As Integer
Dim xEMonth As Integer
Dim xEDay As Integer
Dim xEYear As Integer
Dim xAge As Integer
If Not GetDate(SDate, xSYear, xSMonth, xSDay) Then
AgeFunc = "Invalid Date"
Exit Function
End If
If Not GetDate(EDate, xEYear, xEMonth, xEDay) Then
AgeFunc = "Invalid Date"
Exit Function
End If
xAge = xEYear - xSYear
If xSMonth > xEMonth Then
xAge = xAge - 1
ElseIf xSMonth = xEMonth Then
If xSDay > xEDay Then xAge = xAge - 1
End If
If xAge < 0 Then
AgeFunc = "Invalid Date"
Else
AgeFunc = xAge
End If
End Function
Private Function GetDate(ByVal DateStr As String, Y As Integer, M As Integer, D As Integer) As Boolean
Dim I As Long
Dim K As Long
Y = 0
M = 0
D = 0
GetDate = True
On Error Resume Next
I = InStr(1, DateStr, "/")
M = CLng(Left(DateStr, I - 1))
D = CLng(Mid(DateStr, I + 1, InStr(I + 1, DateStr, "/") - I - 1))
Y = CLng(Right(DateStr, Len(DateStr) - InStrRev(DateStr, "/")))
If M < 1 Or M > 12 Or D < 1 Or D > 31 Or Y < 1 Then
GetDate = False
End If
End Function4. Выберите пустую ячейку (в данном примере — C2) и введите формулу: =AgeFunc(A2,B2) (где A2 — дата рождения, B2 — конечная дата), затем нажмите клавишу Enter, чтобы получить возраст, и перетащите маркер автозаполнения на нужные ячейки. См. снимок экрана:
Примечание: Этот код VBA рассчитывает возраст только для дат в формате мм/дд/гггг, например 6/23/1845.
Расчёт возраста по дате рождения с помощью Kutools для Excel
Если даты рождения находятся в стандартном диапазоне (после 1,01.1900), воспользуйтесь утилитой Kutools для Excel — «Помощник по дате и времени», чтобы мгновенно рассчитать возраст по указанным датам рождения.
После бесплатной установкиKutools для Excel выполните следующие действия:
1. Выберите пустую ячейку, в которую нужно вывести возраст, и последовательно нажмите: Kutools > Помощник формул > Помощник по дате и времени. См. снимок экрана:
2. В диалоговом окне Помощник по дате и времени установите флажок «Возраст», выберите в поле Дата рождения дату, на основе которой нужно рассчитать возраст. По умолчанию будет выбрана абсолютная ссылка на ячейку; при необходимости вы можете изменить её на относительную. Затем установите флажок Сегодня и выберите нужный тип результата в раскрывающемся списке раздела Тип вывода результата. См. снимок экрана:
3. Нажмите кнопку ОК, чтобы применить формулу — и вы сразу увидите рассчитанный возраст. При необходимости просто перетащите маркер автозаполнения на нужные ячейки. См. снимок экрана:
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек