Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Расчет полных лет и месяцев - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Расчет полных лет и месяцев (Макросы/Sub)
Расчет полных лет и месяцев
iraci Дата: Понедельник, 10.09.2018, 18:34 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте! Нужен совет о том, каким путем лучше пойти. Есть Excel-файл с кучей данных, необходимо, чтобы пользователь мог проверить у ребенка количество полных лет и месяцев исходя из текущей даты и даты рождения. До сих пор использовалась встроенная функция РАЗНДАТ(), но ради защиты от дурака и дополнительных удобств, хочется провернуть то же самое посредством макроса. К сожалению функция DateDiff() не дает разницу в виде полных лет. Существует ли аналог РАЗНДАТ() в VBA или придется городить огород, выстраивая логику вычисления "вручную"?
 
Ответить
СообщениеЗдравствуйте! Нужен совет о том, каким путем лучше пойти. Есть Excel-файл с кучей данных, необходимо, чтобы пользователь мог проверить у ребенка количество полных лет и месяцев исходя из текущей даты и даты рождения. До сих пор использовалась встроенная функция РАЗНДАТ(), но ради защиты от дурака и дополнительных удобств, хочется провернуть то же самое посредством макроса. К сожалению функция DateDiff() не дает разницу в виде полных лет. Существует ли аналог РАЗНДАТ() в VBA или придется городить огород, выстраивая логику вычисления "вручную"?

Автор - iraci
Дата добавления - 10.09.2018 в 18:34
Gustav Дата: Понедельник, 10.09.2018, 20:03 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2695
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Любую функцию можно заплести в код VBA через метод Evaluate:
[vba]
Код
? Application.Evaluate("=DATEDIF(DATE(2001,6,1),DATE(2002,8,15),""D"")")
440
[/vba]
что соответствует формуле в ячейке:
Код
=РАЗНДАТ(ДАТА(2001;6;1);ДАТА(2002;8;15);"D")


МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеЛюбую функцию можно заплести в код VBA через метод Evaluate:
[vba]
Код
? Application.Evaluate("=DATEDIF(DATE(2001,6,1),DATE(2002,8,15),""D"")")
440
[/vba]
что соответствует формуле в ячейке:
Код
=РАЗНДАТ(ДАТА(2001;6;1);ДАТА(2002;8;15);"D")

Автор - Gustav
Дата добавления - 10.09.2018 в 20:03
StoTisteg Дата: Вторник, 11.09.2018, 12:52 | Сообщение № 3
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
К сожалению функция DateDiff() не дает разницу в виде полных лет.
Мне даёт:[vba]
Код
Sub test()

   Cells(2, 2).Value = DateDiff("yyyy", CDate(Cells(2, 1).Value), Now)
   Cells(2, 3).Value = DateDiff("m", CDate(Cells(2, 1).Value), Now) - Cells(2, 2).Value * 12

End Sub
[/vba]Что я делаю не так?
К сообщению приложен файл: 3897080.xlsm (13.0 Kb)


Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Вторник, 11.09.2018, 12:58
 
Ответить
Сообщение
К сожалению функция DateDiff() не дает разницу в виде полных лет.
Мне даёт:[vba]
Код
Sub test()

   Cells(2, 2).Value = DateDiff("yyyy", CDate(Cells(2, 1).Value), Now)
   Cells(2, 3).Value = DateDiff("m", CDate(Cells(2, 1).Value), Now) - Cells(2, 2).Value * 12

End Sub
[/vba]Что я делаю не так?

Автор - StoTisteg
Дата добавления - 11.09.2018 в 12:52
iraci Дата: Среда, 12.09.2018, 17:19 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
StoTisteg, эта формула хороша, если месяц рождения младше или равен месяцу той даты, на которую мы хотим узнать количество полных лет. Поставьте в дате рождения месяц старе настоящего, и получится не то, что хотелось бы увидеть. То есть правильнее было бы сказать, что эта формула не всегда дает разницу в виде полных лет. Можно конечно допилить, но вдруг есть более простое решение...


Сообщение отредактировал iraci - Среда, 12.09.2018, 17:22
 
Ответить
СообщениеStoTisteg, эта формула хороша, если месяц рождения младше или равен месяцу той даты, на которую мы хотим узнать количество полных лет. Поставьте в дате рождения месяц старе настоящего, и получится не то, что хотелось бы увидеть. То есть правильнее было бы сказать, что эта формула не всегда дает разницу в виде полных лет. Можно конечно допилить, но вдруг есть более простое решение...

Автор - iraci
Дата добавления - 12.09.2018 в 17:19
iraci Дата: Среда, 12.09.2018, 18:04 | Сообщение № 5
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
Неожиданно нашлось самое простое решение. Оказывается в Excel'е есть возможность, чтобы формула автоматически вставлялась в ячейку при добавлении строки в таблицу (все данные оформлены во встроенную таблицу) и при этом копируется не только формула, но и формат ячейки (ячейки с формулами ес-но защищены от изменений), то есть все ячейки в столбце таблицы окажутся защищаемыми и пользователь не сможет убить в них формулы. Хотя, вероятно, вставку формулы и определение формата ячейки можно осуществить и программно и это, мне кажется, было бы проще, чем корячиться с расчетом полных лет и месяцев вручную. Сейчас необходимости в этом уже нет, но учиться придется еще многому. Спасибо всем, кто принял участие в решении моей проблемы :)


Сообщение отредактировал iraci - Среда, 12.09.2018, 18:04
 
Ответить
СообщениеНеожиданно нашлось самое простое решение. Оказывается в Excel'е есть возможность, чтобы формула автоматически вставлялась в ячейку при добавлении строки в таблицу (все данные оформлены во встроенную таблицу) и при этом копируется не только формула, но и формат ячейки (ячейки с формулами ес-но защищены от изменений), то есть все ячейки в столбце таблицы окажутся защищаемыми и пользователь не сможет убить в них формулы. Хотя, вероятно, вставку формулы и определение формата ячейки можно осуществить и программно и это, мне кажется, было бы проще, чем корячиться с расчетом полных лет и месяцев вручную. Сейчас необходимости в этом уже нет, но учиться придется еще многому. Спасибо всем, кто принял участие в решении моей проблемы :)

Автор - iraci
Дата добавления - 12.09.2018 в 18:04
iraci Дата: Среда, 12.09.2018, 18:13 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
ан нет, при включении защиты листа формула перестала копироваться((( попробую программно вставить формулу и сделать ячейку защищенной...


Сообщение отредактировал iraci - Среда, 12.09.2018, 18:15
 
Ответить
Сообщениеан нет, при включении защиты листа формула перестала копироваться((( попробую программно вставить формулу и сделать ячейку защищенной...

Автор - iraci
Дата добавления - 12.09.2018 в 18:13
StoTisteg Дата: Четверг, 13.09.2018, 10:48 | Сообщение № 7
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Поставьте в дате рождения месяц старе настоящего, и получится не то, что хотелось бы увидеть
Эффект забавный, но легко поправимый:[vba]
Код
Sub test()

   Cells(2, 2).Value = DateDiff("yyyy", CDate(Cells(2, 1).Value), Now)
   Cells(2, 3).Value = Abs(DateDiff("m", CDate(Cells(2, 1).Value), Now) - Cells(2, 2).Value * 12)

End Sub
[/vba]


Интуитивно понятный код - это когда интуитивно понятно, что это код.

Сообщение отредактировал StoTisteg - Четверг, 13.09.2018, 11:02
 
Ответить
Сообщение
Поставьте в дате рождения месяц старе настоящего, и получится не то, что хотелось бы увидеть
Эффект забавный, но легко поправимый:[vba]
Код
Sub test()

   Cells(2, 2).Value = DateDiff("yyyy", CDate(Cells(2, 1).Value), Now)
   Cells(2, 3).Value = Abs(DateDiff("m", CDate(Cells(2, 1).Value), Now) - Cells(2, 2).Value * 12)

End Sub
[/vba]

Автор - StoTisteg
Дата добавления - 13.09.2018 в 10:48
Kuzmich Дата: Четверг, 13.09.2018, 11:36 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 155 ±
Замечаний: 0% ±

Excel 2003
UDF
[vba]
Код
Function Возраст(ДатаРождения As Date) As Integer
Dim flag As Boolean
    flag = CDate(Day(ДатаРождения) & "." & Month(ДатаРождения) & "." & Year(Date)) > Date
        Возраст = Year(Date) - Year(ДатаРождения) + flag
End Function
Function КолМесяцев(ДатаРождения As Date) As Integer
Dim flag As Boolean
    flag = CDate(Day(ДатаРождения) & "." & Month(Date) & "." & Year(Date)) > Date
  КолМесяцев = DateDiff("m", CDate(ДатаРождения), Date)  + flag
End Function
[/vba]

Код
=РАЗНДАТ(A1;СЕГОДНЯ();"y")&"г."&РАЗНДАТ(A1;СЕГОДНЯ();"ym")&"мес."&РАЗНДАТ(A1;СЕГОДНЯ();"md")&"дн."


Сообщение отредактировал Kuzmich - Четверг, 13.09.2018, 12:03
 
Ответить
СообщениеUDF
[vba]
Код
Function Возраст(ДатаРождения As Date) As Integer
Dim flag As Boolean
    flag = CDate(Day(ДатаРождения) & "." & Month(ДатаРождения) & "." & Year(Date)) > Date
        Возраст = Year(Date) - Year(ДатаРождения) + flag
End Function
Function КолМесяцев(ДатаРождения As Date) As Integer
Dim flag As Boolean
    flag = CDate(Day(ДатаРождения) & "." & Month(Date) & "." & Year(Date)) > Date
  КолМесяцев = DateDiff("m", CDate(ДатаРождения), Date)  + flag
End Function
[/vba]

Код
=РАЗНДАТ(A1;СЕГОДНЯ();"y")&"г."&РАЗНДАТ(A1;СЕГОДНЯ();"ym")&"мес."&РАЗНДАТ(A1;СЕГОДНЯ();"md")&"дн."

Автор - Kuzmich
Дата добавления - 13.09.2018 в 11:36
Gustav Дата: Четверг, 13.09.2018, 12:10 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2695
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Эффект забавный, но легко поправимый:

И ? Было 4 года и -3 месяца, т.е. 45 месяцев. По РАЗНДАТ получается 44 полных месяца, что близко и различие списывается, видимо, на округляющую способность DateDiff. Сейчас, после Abs, 4 года и 3 месяца, т.е. 51 месяц...

P.S. Моя версия в копилку:
[vba]
Код
Sub test2()
    Cells(2, 2).Value = Evaluate("DATEDIF(" & CLng(Int(Cells(2, 1).Value)) & "," & CLng(Int(Now)) & ",""Y"")")
    Cells(2, 3).Value = Evaluate("DATEDIF(" & CLng(Int(Cells(2, 1).Value)) & "," & CLng(Int(Now)) & ",""YM"")")
End Sub
[/vba]


МОИ: Ник, Tip box: 41001663842605

Сообщение отредактировал Gustav - Четверг, 13.09.2018, 12:31
 
Ответить
Сообщение
Эффект забавный, но легко поправимый:

И ? Было 4 года и -3 месяца, т.е. 45 месяцев. По РАЗНДАТ получается 44 полных месяца, что близко и различие списывается, видимо, на округляющую способность DateDiff. Сейчас, после Abs, 4 года и 3 месяца, т.е. 51 месяц...

P.S. Моя версия в копилку:
[vba]
Код
Sub test2()
    Cells(2, 2).Value = Evaluate("DATEDIF(" & CLng(Int(Cells(2, 1).Value)) & "," & CLng(Int(Now)) & ",""Y"")")
    Cells(2, 3).Value = Evaluate("DATEDIF(" & CLng(Int(Cells(2, 1).Value)) & "," & CLng(Int(Now)) & ",""YM"")")
End Sub
[/vba]

Автор - Gustav
Дата добавления - 13.09.2018 в 12:10
StoTisteg Дата: Четверг, 13.09.2018, 17:10 | Сообщение № 10
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
Ну да, доброе утро раньше обеда не наступает :) Нужно анализировать месяц, вычитать 1 год и результат моей первой формулы вычитать из 12.


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
СообщениеНу да, доброе утро раньше обеда не наступает :) Нужно анализировать месяц, вычитать 1 год и результат моей первой формулы вычитать из 12.

Автор - StoTisteg
Дата добавления - 13.09.2018 в 17:10
iraci Дата: Четверг, 13.09.2018, 18:50 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 19
Репутация: 0 ±
Замечаний: 0% ±

Excel 2007
В VBA я - новичок, благодаря вам, дорогие участники этой темы, мне удалось почерпнуть много интересного и полезного, хотя признаюсь, что ясно пока не все, но дело сделано и на данный момент все работает правильно, еще раз спасибо :)
 
Ответить
СообщениеВ VBA я - новичок, благодаря вам, дорогие участники этой темы, мне удалось почерпнуть много интересного и полезного, хотя признаюсь, что ясно пока не все, но дело сделано и на данный момент все работает правильно, еще раз спасибо :)

Автор - iraci
Дата добавления - 13.09.2018 в 18:50
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Расчет полных лет и месяцев (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!