Vba 将天数转换为年、月、日

Question

I have this code that shows how old (by days) a file is:

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

Is there anyway that I can convert it to a format like this, lets say "0 Year 3 Months 3 days"?

Answer 1

As has already been noted by other users, you're going to run into difficulties because different months have different day counts and week counts (and a given year might have different day counts as well).

I think your best bet is to "assume" that a month has a given number of days (eg 30) and that you're not in a leap year. Then your algorithm would be something like this:

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

This is the sub that I came up with to accomplish this task. I take a bit of a step back from your code. If I read your question right, you have a cell that contains a date Range("D" & startrow) and you then calculate the raw number of days since that date, and were then going to convert that number to years, months days. My code instead takes the string of the date from the cell (ex: 3/1/2019) and then calculates the years, months, and days passed independently. It takes into account the different days per each month and leap years and through my testing the only logic that isn't handled is if the date in the cell is actually in the future - I hope that's okay.

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

This is the output All you should have to do to make it work for your individual worksheet is change the mySheet, dateCell, and outputCell variables. My date cells are set to the format of mm/dd/yyyy. I have not tested it with other date formats.

Answer 3

Here's my solution. I'm using this in my company, though it's written in Indonesian language as that's where I come from. It's a function where it takes two arguments: tanggal_akhir (which translates to 'start date') and tanggal_mulai (which translates to 'end date'). Formula is BEDATANGGAL which means 'date difference'. Hope it helps.

Function BEDATANGGAL(tanggal_mulai As Date, tanggal_akhir As Date)

Dim hari As Integer
Dim bulan As Integer
Dim tahun As Integer
Dim durasi As Integer
Dim tambah As Date

hari = 0
bulan = 0
tahun = 0
tambah = tanggal_mulai

durasi = DateDiff("d", tanggal_mulai, tanggal_akhir) - 1

For i = 0 To durasi

hari = hari + 1
tambah = tambah + 1

If Day(tanggal_mulai) = Day(tambah) Then

    hari = 0
    bulan = bulan + 1

    End If

If bulan = 12 Then

    hari = 0
    bulan = 0
    tahun = tahun + 1

    End If

Next i

BEDATANGGAL = tahun & " tahun, " & bulan & " bulan, " & hari & " hari"

End Function

Answer 4

Modification to the above answer by tyler

Function date_duration(start_date, end_date)
'Worksheet Variables

Dim dateCell, outputCell As Range



'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 = start_date
fileYear = CInt(Split(fileDate, "/")(2))
fileMonth = CInt(Split(fileDate, "/")(0))
fileDay = CInt(Split(fileDate, "/")(1))

'Get the current date, year, month, and day
curDate = end_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
date_duration = years & " Years, " & months & " Months, " & days & " Days"
End Function

Answer 5

Try the following.

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