Exacte leeftijd berekenen

[OctaFish]

Gelukkig nog nét binnen de 40 berichten gebleven; dit draadje begint ouderwets te worden qua lengte. En het is in beginsel zo'n simpele vraag .

Maar goed, na het noeste handwerk hier dan de functie die, voor zover ik kan zien, de juiste uitkomsten oplevert. Gebruik hem voor de grap in een query naast die van Peter, en zoek de verschillen. Ik heb die van snb overigens nog niet getest, gezien de drukte in dit topic.

Function LeeftijdExact(Geb_Dat As Date, Optional Peildatum As Date) As String
Dim iJ As Integer, iM As Integer, iD As Integer, sGeb As String, sPeil As String
Dim sM As String, sD As String, sM_ As String, sD_ As String
Const sJ As String = " jaar"

    If Not IsDate(Geb_Dat) Then GoTo Hell
   
    If Not IsNull(Peildatum) Then Peildatum = Date
    sGeb = Format(Geb_Dat, "mmdd"): sPeil = Format(Peildatum, "mmdd")
   
        'jaar = vandaag, maand kleiner dan vandaag, en dag kleiner dan vandaag
        If CInt(Left(sGeb, 2)) <= CInt(Left(sPeil, 2)) And CInt(Right(sGeb, 2)) <= CInt(Right(sPeil, 2)) Then
            iJ = CInt(DateDiff("yyyy", Geb_Dat, Peildatum))
            iM = CInt(DateDiff("m", DateSerial(Year(Peildatum), Month(Geb_Dat), Day(Geb_Dat)), Peildatum))
            iD = Abs(CInt(DateDiff("d", DateSerial(Year(Peildatum), (Month(Peildatum)) - bD, Day(Geb_Dat)), Peildatum)))
       
        'jaar = vandaag, maand kleiner dan vandaag, en dag groter dan vandaag
        ElseIf CInt(Left(sGeb, 2)) <= CInt(Left(sPeil, 2)) And CInt(Right(sGeb, 2)) > CInt(Right(sPeil, 2)) Then
            iJ = CInt(DateDiff("yyyy", Geb_Dat, Peildatum))
            iM = CInt(DateDiff("m", DateSerial(Year(Peildatum), Month(Geb_Dat) + 1, Day(Geb_Dat)), Peildatum))
            iD = Abs(CInt(DateDiff("d", DateSerial(Year(Peildatum), (Month(Peildatum) - 1), Day(Geb_Dat)), Peildatum)))
       
        'jaar = vorig jaar, maand groter dan vandaag, en dag kleiner dan vandaag
        ElseIf CInt(Left(sGeb, 2)) > CInt(Left(sPeil, 2)) And CInt(Right(sGeb, 2)) <= CInt(Right(sPeil, 2)) Then
            iJ = CInt(DateDiff("yyyy", Geb_Dat, Peildatum)) - 1
            iM = 12 + CInt(DateDiff("m", DateSerial(Year(Peildatum), Month(Geb_Dat), Day(Geb_Dat)), Peildatum))
            iD = Abs(CInt(DateDiff("d", DateSerial(Year(Peildatum), Month(Peildatum), Day(Geb_Dat)), Peildatum)))
        'jaar = vorig jaar, maand groter dan vandaag, en dag groter dan vandaag
        ElseIf CInt(Left(sGeb, 2)) > CInt(Left(sPeil, 2)) And CInt(Right(sGeb, 2)) > CInt(Right(sPeil, 2)) Then
            iJ = CInt(DateDiff("yyyy", Geb_Dat, Peildatum)) - 1
            iM = 12 + CInt(DateDiff("m", DateSerial(Year(Peildatum), Month(Geb_Dat), Day(Geb_Dat)), Peildatum))
            iD = Abs(CInt(DateDiff("d", DateSerial(Year(Peildatum), (Month(Peildatum)), Day(Geb_Dat)), Peildatum)))
   
        End If
   
    'String samenstellen
    sM = Switch(iM = 0, "", iM = 1, " maand", iM <> 1, " maanden")
    sM_ = IIf(iM = 0, "", ", " & iM & sM)
    sD = Switch(iD = 0, "", iD = 1, " dag", iD > 1, " dagen")
    sD_ = IIf(iD = 0, "", ", " & iD & sD)

    LeeftijdExact = iJ & sJ & sM_ & sD_
''    MsgBox LeeftijdExact
    Exit Function

Hell:
    LeeftijdExact = "Geen juiste datum"


End Function

Ik heb 'm met opzet vrij uitgebreid opgezet, zodat je kunt zien wat er gebeurt in de 4 mogelijke varianten. Die worden allemaal afzonderlijk berekend, vandaar de vele IFjes.
Zoals ik al eerder schreef, er zijn een aantal mogelijkheden.
1. jaar = vandaag, maand kleiner dan vandaag, en dag kleiner dan vandaag
2. jaar = vandaag, maand kleiner dan vandaag, en dag groter dan vandaag
3. jaar = vorig jaar, maand groter dan vandaag, en dag kleiner dan vandaag
4. jaar = vorig jaar, maand groter dan vandaag, en dag groter dan vandaag

Die moet je allemaal apart verwerken. Dus dat gebeurt in de verschillende stappen van de functie.

Ik heb, in tegenstelling tot de functie van Peter, wél twee argumenten in de functie gezet, zodat je met zowel een peildatum kunt werken, als met de huidige datum. Vul je geen peildatum in, dan krijg je automatisch de berekening op basis van de huidige datum. Lijkt mij een stuk vriendelijker in het gebruik dan altijd een peildatum te moeten invullen.

 

[NoellaG]

@Enigmasmurf: ik geef je toch gelijk???? Alleen een wat meer algemene uitleg.

 

[Enigmasmurf]

Zo klonk het niet... Je post gaf de indruk dat die aan mij was gericht, en als je het dan over een verkeerde assumptie hebt, tja.
Maar fijn te vernemen dat we al met drieën het licht hebben gezien. Raar dat er ondertussen toch nog pogingen worden ondernomen

 

[NoellaG]

@OctaFish: wel veel stappen hé

 

[Pletter]

Misschien deze uitvoering.

Groet,

 

[OctaFish]

@OctaFish: wel veel stappen hé

Ik heb toch gezegd: ik heb het in kleine stappen uitgewerkt .

Hier overigens een voorbeeldje met de verschillende (geteste) functies.



Zoek de verschillen .