Waarde omzetten in jaren, maanden en dagen

Status
Niet open voor verdere reacties.

YDKMAA

Nieuwe gebruiker
Lid geworden
20 jul 2010
Berichten
4
In Word heb ik de volgende uitdaging:

Ik heb een startdatum en ik heb een einddatum.
Als ik deze van elkaar aftrek (EindDatum-StartDatum) krijg ik een waarde bijvoorbeeld 430.
Hoe kan ik deze waarde (VBA code?) omzetten naar de tekst: 1 jaar, 2 maanden en 6 dagen?

Elke hulp is zeer welkom en is gewaardeerd!!!:d
 
Laatst bewerkt:
Probeer dit eens.
Ik moest even denken hoe het te doen, maar volgens mij is dit wat je wilt.

Bedankt voor de leuke vraag.

EDIT: je kunt trouwens nooit nauwkeurig 430 dagen omzetten in maanden, dagen, jaren.
Wat je moet doen is Startdatum en einddatum met elkaar vergelijken met onderstaande Functie

Code:
Sub test()
'gebruik:
MsgBox Datumspec(Date - 430, Date)
End Sub
Code:
Function Datumspec(startdatum As Date, einddatum As Date) As String
'Door Mark xl
Dim Jaren As Long, Maanden As Long, Dagen As Long
Dim i As Long
Do While DateAdd("yyyy", 1, startdatum) <= einddatum
    startdatum = DateAdd("yyyy", 1, startdatum)
    Jaren = Jaren + 1
Loop

If Jaren <> 1 Then
    Datumspec = Jaren & " Jaren, "
Else
    Datumspec = Jaren & " Jaar, "
End If

Do While DateAdd("m", 1, startdatum) <= einddatum
    startdatum = DateAdd("m", 1, startdatum)
    Maanden = Maanden + 1
Loop

If Maanden <> 1 Then
    Datumspec = Datumspec & Maanden & " Maanden, "
Else
    Datumspec = Datumspec & Maanden & " Maand, "
End If

Do While DateAdd("d", 1, startdatum) <= einddatum
    startdatum = DateAdd("d", 1, startdatum)
    Dagen = Dagen + 1
Loop

If Dagen <> 1 Then
    Datumspec = Datumspec & Dagen & " Dagen."
Else
    Datumspec = Datumspec & Dagen & " Dag."
End If
End Function
 
Laatst bewerkt:
Hartelijk dank Mark xl, het is precies wat ik zocht!:):d:):d:):d:):d
 
Dan kun je de vraag markeren als opgelost.

Ik heb trouwens de functie nog iets aangepast. nu is de uitkomst grammaticaal gezien correct.

Code:
Function Datumspec(startdatum As Date, einddatum As Date) As String
'Door Mark xl
'deze functie lijkt uitgebreid, maar is bliksemsnel
Dim Jaren As Long, Maanden As Long, Dagen As Long
'jaren
Do While DateAdd("yyyy", 1, startdatum) <= einddatum
    startdatum = DateAdd("yyyy", 1, startdatum)
    Jaren = Jaren + 1
Loop
'maanden
Do While DateAdd("m", 1, startdatum) <= einddatum
    startdatum = DateAdd("m", 1, startdatum)
    Maanden = Maanden + 1
Loop
'dagen
Do While DateAdd("d", 1, startdatum) <= einddatum
    startdatum = DateAdd("d", 1, startdatum)
    Dagen = Dagen + 1
Loop

Select Case Dagen
    Case 0
    Case 1
        Datumspec = "1 dag"
    Case Is > 1
        Datumspec = Dagen & " dagen"
End Select

Select Case Maanden
    Case 0
        Select Case Jaren
            Case 0
            Case 1
                Datumspec = "1 jaar en " & Datumspec
            Case Else
                Datumspec = Jaren & " jaar en " & Datumspec
        End Select
    Case 1
        Select Case Jaren
            Case 0
                Datumspec = "1 maand en " & Datumspec
            Case 1
                Datumspec = "1 jaar, 1 maand en " & Datumspec
            Case Is > 1
                Datumspec = Jaren & " jaar, 1 maand en " & Datumspec
        End Select
    Case Is > 1
        Select Case Jaren
            Case 0
                Datumspec = Maanden & " maanden en " & Datumspec
            Case 1
                Datumspec = "1 jaar, " & Maanden & " maanden en " & Datumspec
            Case Is > 1
                Datumspec = Jaren & " jaar, " & Maanden & " maanden en " & Datumspec
        End Select
End Select
If Right(Datumspec, 4) = " en " Then Datumspec = Replace(Mid(Datumspec, 1, Len(Datumspec) - 4), ",", " en")
End Function
 
Laatst bewerkt:
Mark xl,

Dit is tekstueel inderdaad beter! Nu is mijn afdeling Juridische zaken nog meer tevreden!!!

YDKMAA
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan