powered by simpleCommunicator - 2.0.58     © 2025 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / изменить дату на возраст
16 сообщений из 16, страница 1 из 1
изменить дату на возраст
    #38220532
aleksey_dannik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
изменить дату на возраст. Например: дата рождения = 10.10.1987 нужно получить возраст = 36 лет
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38220542
Maxim12345678
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Например, РАЗНДАТ ("Ячейка с датой возраста";СЕГОДНЯ();"y")
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38220550
aleksey_dannik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
не вышло
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38220577
Фотография Serge 007
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
aleksey_dannik, а если всё же попробовать ?
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38220620
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
aleksey_dannikНапример: дата рождения = 10.10.1987 нужно получить возраст = 36 лет
...
не вышлоРазумеется. Потому что получается 26 лет.
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38220623
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
*25 лет
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38220805
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не так давно 13903561 мы придумывали такую функцию для Фокса.
Предлагаю:
Код: vbnet
1.
2.
3.
Public Function Age(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    Age = Int((Val(Format(ТекущаяДата, "yyyymmdd", 2)) - Val(Format(ДатаРождения, "yyyymmdd", 2))) / 10000)
End Function
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221435
aleksey_dannik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
спасибо за формулу разница дат, а как вытянуть год с одной даты?
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221445
Maxim12345678
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
В смысле? Если стоит дата в ячейке А1 типа 15.11.1987, то =ГОД(A1) должен вытащить тебе 1987 год.
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221451
aleksey_dannik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
год вытаскивает, а возраст?
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221456
Maxim12345678
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
aleksey_dannikгод вытаскивает, а возраст?

Ничего не понял... так а почему не использовать РАЗНДАТ, как уже приводилось выше? Она прекрасно подходит для твоего вопроса...
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221459
aleksey_dannik
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Да спасибо разобрался. Спасибо.
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221640
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
AndreTMНе так давно 13903561 мы придумывали такую функцию для Фокса.
Предлагаю:
Код: vbnet
1.
2.
3.
Public Function Age(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    Age = Int((Val(Format(ТекущаяДата, "yyyymmdd", 2)) - Val(Format(ДатаРождения, "yyyymmdd", 2))) / 10000)
End Function


Красиво! Реализация этого способа формулой Excel

Код: plaintext
=ОТБР((ТЕКСТ(B1;"ГГГГММДД")-ТЕКСТ(A1;"ГГГГММДД"))/10000)

Я когда-то придумал такой вариант

Код: plaintext
=ГОД(B1)-ГОД(A1)-(ТЕКСТ(A1;"ММДД")>ТЕКСТ(B1;"ММДД"))

Формула короче, но ваш вариант более однородный, что ли.
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221684
Казанский
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
В той теме был затронут вопрос быстродействия. Для VB(A) функцию можно оптимизировать. Я добился ускорения на 23% без изменения алгоритма и более чем в 2 раза - с изменением. Варианты функции и процедура тестирования - ниже:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
Public Function Age(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    
'исходная функция
    
    Age = Int((Val(Format(ТекущаяДата, "yyyymmdd", 2)) - Val(Format(ДатаРождения, "yyyymmdd", 2))) / 10000)
End Function

Public Function Age1(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    
'переход на целочисленную арифметику
    
    Age1 = (CLng(Format(ТекущаяДата, "yyyymmdd")) - CLng(Format(ДатаРождения, "yyyymmdd"))) \ 10000
End Function

Public Function Age2(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    
'сравнение строк вместо перевода из строк в числа (аналог моей функции в Excel)
    
    Age2 = Year(ТекущаяДата) - Year(ДатаРождения) + (Format(ДатаРождения, "mmdd") > Format(ТекущаяДата, "mmdd"))
End Function

Public Function Age3(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    
'работа только с числами, сравнение дней только при равенстве месяцев
    
    Age3 = Year(ТекущаяДата) - Year(ДатаРождения)
    Select Case Month(ДатаРождения) - Month(ТекущаяДата)
    Case Is < 0
    Case Is > 0
        Age3 = Age3 - 1
    Case Else
        If Day(ДатаРождения) > Day(ТекущаяДата) Then Age3 = Age3 - 1
    End Select
End Function

Public Function Age4(ДатаРождения As Date, ТекущаяДата As Date) As Integer
    
'вычисляемый GoTo вместо Select Case
    
    Age4 = Year(ТекущаяДата) - Year(ДатаРождения)
    On Sgn(Month(ДатаРождения) - Month(ТекущаяДата)) + 2 GoTo 1, 2, 3
2   If Day(ДатаРождения) > Day(ТекущаяДата) Then Age4 = Age4 - 1
1   Exit Function
3   Age4 = Age4 - 1
End Function

Sub test()
Dim d1 As Date, d2 As Date, t!, i&
d1 = #7/1/1987#

'Проверка, что функции дают одинаковый результат в любой день года
    
    For d2 = #1/1/2012# To #12/31/2012#
        t = Age(d1, d2)
        If t <> Age1(d1, d2) Or t <> Age2(d1, d2) Or t <> Age3(d1, d2) Or t <> Age4(d1, d2) Then Stop
    Next

'Измерение времени расчета

t = Timer
For i = 1 To 1000
    For d2 = #1/1/2012# To #12/31/2012#
        Age4 d1, d2
    Next
Next
Debug.Print Timer - t
End Sub


Результаты (Core2Duo 1.6GHz WinXP Office2007), с каждой функцией запускал по 2 раза
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
 1,859375 
 1,90625    Age
 1,4375 
 1,421875   Age1
 1,25 
 1,21875    Age2
 0,859375 
 0,84375    Age3
 0,75 
 0,8125     Age4
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38221934
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Казанский,

Очень неплохо. Конечно, вариант с GoTo для многих других ЯП не пойдет, а вот Case заслуживает рассмотрения... Попробую потестировать использование на реальных данных.
...
Рейтинг: 0 / 0
изменить дату на возраст
    #38223545
Фотография AndreTM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
AndreTM Казанский, Очень неплохо. Конечно, вариант с GoTo для многих других ЯП не пойдет, а вот Case заслуживает рассмотрения... Попробую потестировать использование на реальных данных.Не, не идёт. Попробовал на VFP реализовать Age2,3 - получается медленнее, чем исходный вариант. Возможно, потому, что в VFP dtos() - встроенная функция, и выигрывает у функции VBA format().
...
Рейтинг: 0 / 0
16 сообщений из 16, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / изменить дату на возраст
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]