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 .

 

[xps351]

Oeps, ik schaam me diep.

 

[xps351]

Ik kreeg gisteren kennelijk lasogen en zag het verschil tussen < en > niet meer, evenmin als het verschil tussen A - B en B - A
Testresultaten bekijken bracht me ook al niet op andere gedachten.
Hoe dan ook, vandaag met frisse moed mijn functie in lijn met de eerder gekozen aanpak aangepast tot:

Function LeeftijdOp(Geboortedatum As Variant, Peildatum As Date) As Variant
Dim Maanden As Integer
Dim Dagen As Byte

If Format(Geboortedatum, "mmdd") > Format(Peildatum, "mmdd") Then
    LeeftijdOp = DateDiff("yyyy", Geboortedatum, Peildatum) - 1 & " jaar, "
Else
    LeeftijdOp = DateDiff("yyyy", Geboortedatum, Peildatum) & " jaar, "
End If

Maanden = Month(Peildatum) - Month(Geboortedatum)

If Day(Peildatum) < Day(Geboortedatum) Then
    Maanden = Maanden - 1
End If

If Maanden < 0 Then
    Maanden = Maanden + 12
End If

If Maanden <> 1 Then
    LeeftijdOp = LeeftijdOp & Maanden & " maanden en "
Else
    LeeftijdOp = LeeftijdOp & Maanden & " maand en "
End If

If Day(Peildatum) < Day(Geboortedatum) Then
    Dagen = DateDiff("d", DateSerial(Year(Peildatum), Month(Peildatum) - 1, Day(Geboortedatum)), Peildatum)
Else
    Dagen = Day(Peildatum) - Day(Geboortedatum)
End If

If Dagen <> 1 Then
    LeeftijdOp = LeeftijdOp & Dagen & " dagen"
Else
    LeeftijdOp = LeeftijdOp & Dagen & " dag"
End If

End Function

En, voilà:


Overigens knap van @snb om dat met zo weinig regels voor elkaar te krijgen (alleen jammer dat ik Option Explicit uit moest zetten). Daar zou de oude @OctaFish jaloers op zijn geweest

 

[xps351]

Ik zie nu pas de foute waardes bij @OctaFish . -2 maanden bij de persoon geboren op 31-08. Ook de eind september, oktober, november en december boorlingen geven een afwijkend (lees: fout) resultaat.

 

[OctaFish]

Overigens knap van @snb om dat met zo weinig regels voor elkaar te krijgen (alleen jammer dat ik Option Explicit uit moest zetten). Daar zou de oude @OctaFish jaloers op zijn geweest

De 'oude' octafish heeft hele andere zaken aan zijn hoofd.... Ik vond het al heel wat dat ik nog de tijd heb gevonden om deze constructie te maken, die ik heb omgebouwd uit een andere db. Blijkbaar niet alle varianten getest, als er nog fouten in zaten. En ik was ook begonnen met een veel kortere procedure, want ik vond 'm ook nogal lang. Daar zaten meer fouten in dan ik wilde, dus daarom de oorspronkelijke gebruikt.
Maar goed, ik ben binnekort weg, dus van mij (oud of nieuw) zul je straks geen last meer hebben .