Vba конвертировать дни в годы, месяцы, дни

Question

У меня есть этот код, который показывает, сколько лет (по дням) файлу:

Date_Created = Worksheets("FileCleaner").Range("D" & startrow).Value
File_Age_Day = DateDiff("d", Date_Created, Date)
Worksheets("FileCleaner").Range("E" & startrow).Value = File_Age_Day

В любом случае я могу преобразовать его в такой формат, скажем, «0 год 3 месяца 3»дней "?

Answer 1

Как уже отмечалось другими пользователями, вы столкнетесь с трудностями, потому что разные месяцы имеют разное количество дней и количество недель (и в данном году также могут быть разные числа дней).

Я думаю, что вам лучше всего "предположить", что месяц имеет определенное количество дней (например, 30) и что вы не в високосном году. Тогда ваш алгоритм будет выглядеть примерно так:

Private Const DAYS_IN_YEAR As Integer = 365
Private Const DAYS_IN_MONTH As Integer = 30

Public Sub OutputElapsed(days As Integer)
    Dim years As Integer, months As Integer, daysRemaining As Integer

    years = Int(days / DAYS_IN_YEAR)
    daysRemaining = days - (years * DAYS_IN_YEAR)

    months = Int(daysRemaining / DAYS_IN_MONTH)
    daysRemaining = daysRemaining - (months * DAYS_IN_MONTH)

    Debug.Print _
            years & " years, " & _
            months & " months, " & _
            daysRemaining & " days"
End Sub

Answer 2

Это подводная лодка, которую я придумал, чтобы выполнить эту задачу. Я немного отступлю от вашего кода. Если я правильно прочитал ваш вопрос, у вас есть ячейка с датой Range("D" & startrow), и вы затем рассчитаете общее число дней с этой даты, а затем собирались преобразовать это число в годы, месяцы, дни. Вместо этого мой код берет строку даты из ячейки (например, 01.03.2009), а затем вычисляет годы, месяцы и дни, пройденные независимо. Он учитывает разные дни в каждом месяце и високосные годы, и в ходе моего тестирования единственная логика, которая не обрабатывается, - это если дата в ячейке действительно в будущем - я надеюсь, что все в порядке.

Sub DateCalc()
    'Worksheet Variables
    Dim mySheet As Worksheet
    Dim dateCell, outputCell As Range

    Set mySheet = Sheets("Sheet1")
    Set dateCell = mySheet.Cells(1, 1)
    Set outputCell = mySheet.Cells(1, 2)

    'Date variables
    Dim fileDate, curDate, tempDate As Date
    Dim fileYear, curYear, tempYear, years, _
    fileMonth, curMonth, tempMonth, months, _
    fileDay, curDay, tempDay, days, _
    curDPM, fileDPM _
    As Integer

    'Get date of file and calculate year, month, and day
    fileDate = dateCell.Value
    fileYear = CInt(Split(fileDate, "/")(2))
    fileMonth = CInt(Split(fileDate, "/")(0))
    fileDay = CInt(Split(fileDate, "/")(1))

    'Get the current date, year, month, and day
    curDate = Date
    curYear = CInt(Split(curDate, "/")(2))
    curMonth = CInt(Split(curDate, "/")(0))
    curDay = CInt(Split(curDate, "/")(1))

    'Calculate years passed
    If curYear > fileYear Then
        years = curYear - fileYear
    End If
    If years = "" Then
        years = 0
    End If

    'Calculate months passed
    If curMonth > fileMonth Then
        months = curMonth - fileMonth
    ElseIf curMonth = fileMonth Then
        months = 0
    ElseIf curMonth < fileMonth Then
        months = (12 - fileMonth) + curMonth
    End If

    'Calculates days per month (DPM) for current year
    Select Case curMonth
        Case 4 Or 6 Or 9 Or 11
            '31-Day months
            'April, June, September, November.
            curDPM = 30
        Case 2
            'February will either have 29 or 28 days
            'If the current year is divisible by 4 it
            'is a leap year and there are 29
            curDPM = IIf(curYear Mod 4 = 0, 29, 28)
        Case Else
            '31-Day months
            curDPM = 31
    End Select

    'Calculates days per month (DPM) for file year
    Select Case fileMonth
        Case 4 Or 6 Or 9 Or 11
            fileDPM = 30
        Case 2
            fileDPM = IIf(fileYear Mod 4 = 0, 29, 28)
        Case Else
            fileDPM = 31
    End Select

    'Calculates days passed
    If curDay > fileDay Then
        days = curDay - fileDay
    ElseIf (curDay = fileDay) Then
        days = 0
    ElseIf (curDay < fileDay) Then
        days = (fileDPM - fileDay) + curDay
    End If

    'years, months, and days are calculate independently
    'so this loop corrects them to work together
    'Ex: 12/31/2000 to 1/1/2001 would be 1 year, 1 month, 1 day without this loop
    Do
        tempDate = DateAdd("yyyy", years, fileDate)
        tempDate = DateAdd("m", months, tempDate)
        tempDate = DateAdd("d", days, tempDate)

        tempYear = CInt(Split(tempDate, "/")(2))
        tempMonth = CInt(Split(tempDate, "/")(0))
        tempDay = CInt(Split(tempDate, "/")(1))

        If tempYear > curYear Then
            years = years - 1
        ElseIf tempYear < curYear Then
            years = years + 1
        End If

        If tempMonth > curMonth Then
            months = months - 1
        ElseIf tempMonth < tempMonth Then
            months = months + 1
        End If

        If tempDay > curDay Then
            days = days - 1
        ElseIf tempDay < curDay Then
            days = days + 1
        End If
    Loop While tempDate <> curDate

    'Set cell to display time passed
    outputCell.Value = years & " Years, " & months & " Months, " & days & " Days"
End Sub

Это вывод Все, что вам нужно сделать, чтобы заставить его работать на вашем отдельном рабочем листе, это изменить переменные mySheet, dateCell и outputCell. Мои ячейки даты установлены в формате мм / дд / гггг. Я не проверял это с другими форматами даты.

Answer 3

Попробуйте следующее.

date_created = Worksheets("FileCleaner").Range("D" & startrow).Value
File_Age_Day = DatePart("yyyy", date_created) & " years, " & DatePart("M", 
date_created) & " Months, " & DatePart("d", date_created) & " days"
Worksheets("FileCleaner").Range("E" & startrow).Value = File_Age_Day