Добрый день! Подскажите как в vba рассчитать разницу между двумя датами и вывести результат в формате - ## дней, ## месяцев, ## лет. Заранее спасибо!
Добрый день! Подскажите как в vba рассчитать разницу между двумя датами и вывести результат в формате - ## дней, ## месяцев, ## лет. Заранее спасибо!WeRiX
Function calculate_date_dif(date_from, date_to) As String Dim y As Integer Dim m As Integer Dim d As Integer
'date_from = #1/1/2012# 'date_to = #25/3/2012#
d = DateDiff("d", date_from, date_to)
y = d \ 365 'kolvo let If y > 0 Then: m = (d \ 30) - (y * 12): Else: m = 0 'Esli <1 goda togda mesyac=0 If d - (y * 365 + m * 30) < 0 Then 'Korrektirovka na raznoe kolvo dneiv mesyacah m = m - 1 ' --- korrektiruem mes d = d - (y * 365 + m * 30) ' --- vis4itivaem dni End If
Function calculate_date_dif(date_from, date_to) As String Dim y As Integer Dim m As Integer Dim d As Integer
'date_from = #1/1/2012# 'date_to = #25/3/2012#
d = DateDiff("d", date_from, date_to)
y = d \ 365 'kolvo let If y > 0 Then: m = (d \ 30) - (y * 12): Else: m = 0 'Esli <1 goda togda mesyac=0 If d - (y * 365 + m * 30) < 0 Then 'Korrektirovka na raznoe kolvo dneiv mesyacah m = m - 1 ' --- korrektiruem mes d = d - (y * 365 + m * 30) ' --- vis4itivaem dni End If
К сожалению не так. Например, разница между датами 05.02.2014 и 04.01.2013 должна быть в виде 1 дня 1 месяца 1 года. У тебя совсем другая логика счета. Но все равно спасибо, где-то и такое пригодится
К сожалению не так. Например, разница между датами 05.02.2014 и 04.01.2013 должна быть в виде 1 дня 1 месяца 1 года. У тебя совсем другая логика счета. Но все равно спасибо, где-то и такое пригодитсяWeRiX
Function Разность_Дат(Дата_нач As Date, Дата_кон As Date) As String Dim Y&, M&, D&, D3 As Date Do While D3 < Дата_кон Y = Y + 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач), Day(Дата_нач)) Loop If D3 = Дата_кон Then Разность_Дат = D & " дней, " & M & " месяцев, " & Y & " лет." Exit Function End If Y = Y - 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач), Day(Дата_нач)) Do While D3 < Дата_кон M = M + 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач) + M, Day(Дата_нач)) Loop If D3 = Дата_кон Then Разность_Дат = D & " дней, " & M & " месяцев, " & Y & " лет." Exit Function End If M = M - 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач), Day(Дата_нач)) Do Until D3 = Дата_кон D = D + 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач) + M, Day(Дата_нач) + D) Loop Разность_Дат = D & " дней, " & M & " месяцев, " & Y & " лет." End Function
[/vba]
как вариант
[vba]
Код
Function Разность_Дат(Дата_нач As Date, Дата_кон As Date) As String Dim Y&, M&, D&, D3 As Date Do While D3 < Дата_кон Y = Y + 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач), Day(Дата_нач)) Loop If D3 = Дата_кон Then Разность_Дат = D & " дней, " & M & " месяцев, " & Y & " лет." Exit Function End If Y = Y - 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач), Day(Дата_нач)) Do While D3 < Дата_кон M = M + 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач) + M, Day(Дата_нач)) Loop If D3 = Дата_кон Then Разность_Дат = D & " дней, " & M & " месяцев, " & Y & " лет." Exit Function End If M = M - 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач), Day(Дата_нач)) Do Until D3 = Дата_кон D = D + 1 D3 = DateSerial(Year(Дата_нач) + Y, Month(Дата_нач) + M, Day(Дата_нач) + D) Loop Разность_Дат = D & " дней, " & M & " месяцев, " & Y & " лет." End Function
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
