leeftijd

[don42]

Beste allemaal,


ik wil graag via vba de leefijd berekenen
Dit heb ik tot nu toe (foutmelding)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("e1") = DATEDIF(Range("c1"), today(), "y")
End Sub

ik wil graag een loop
zolang er in kolom C datums staan
dat er in kolom E de juiste leeftijd komt
wie kan mij hier mee helpen?

Don

 

[Ginger]

Don, Waarom wil je dit met VBA? Zo hou je een statische waarde over, terwijl je 'm als formule gewoon netjes kan laten meelopen (zéker met die "today" in je formule).

 

[edmoor]

Of met een simpele UDF als je het toch in VBA wilt hebben. Plaats deze in een module:

Function Leeftijd(Source As Range) As Integer
    Leeftijd = DateDiff("YYYY", Source.Value, Date)
End Function

 

[don42]

ik ga er mee aan de slag
VBA heeft mijn voorkeur maar de oplossing van elmoor begrijp ik even niet

 

[HSV]

De code van @edmoor zet je in een standaard module.
In de cel zet je:
=leeftijd(c1)

 

[Ginger]

Ha ha ha.... De oplossing van Edmoor is een "jas" om een "jas". Je verpakt de Datedif functie in een andere functie. Dan kan je dus net zo goed de functie Datedif in je worksheet gebruiken. Toch?
Daarnaast blijf ik bij m'n stelling dat "leeftijd" elke dag anders is. Ofwel, dit onder een knop plaatsen gaat er voor zorgen dat je op een gegeven moment met een foute leeftijd bezig bent.

 

[don42]

heb het bestandje even aangepast


Bekijk bijlage vlookup_verjaardag.xlsm

 

[edmoor]

Ha ha ha.... De oplossing van Edmoor is een "jas" om een "jas". Je verpakt de Datedif functie in een andere functie. Dan kan je dus net zo goed de functie Datedif in je worksheet gebruiken. Toch?
Daarnaast blijf ik bij m'n stelling dat "leeftijd" elke dag anders is. Ofwel, dit onder een knop plaatsen gaat er voor zorgen dat je op een gegeven moment met een foute leeftijd bezig bent.

Wat DATEDIFF betreft heb je gelijk, maar met die UDF zit het niet onder een knop en TS wilde het in VB hebben.

 

[Ginger]

@Edmoor, m'n opmerking was overigens niet lelijk bedoeld hoor (mocht dit zo overgekomen zijn). Het viel me alleen maar op.

Daarnaast wil de TS de waardes van de leeftijden statisch hebben. Dus je zou je functie kunnen aansturen vanuit een sub-procedure die je aan een knop hangt (met daarin dus die lus om alle datums in kolom C af te gaan). In dat geval is je functie uiteraard wél prima.

 

[edmoor]

@Edmoor, m'n opmerking was overigens niet lelijk bedoeld hoor (mocht dit zo overgekomen zijn). Het viel me alleen maar op.

Dat weet ik wel

 

[don42]

Ik heb de code van edmoor in een module gezet
dan zet ik in cel (a1) 31-12-1965
in cel (a2) =leeftijd(a1)
dan is het resultaat 51 en dat klopt dus niet (moet 50 zijn)

 

[edmoor]

Het is wat de functie DATEDIFF terug geeft. Maar doe het eens zo:

Function Leeftijd(Source As Range) As Integer
    Dim age As Integer
    age = DateDiff("d", Source.Value, Date)
    Leeftijd = age / 365.25
End Function

 

[HSV]

Hier ook nog een gewone formule.

=DATUMVERSCHIL(A1;VANDAAG();"y")&" jaar, "&DATUMVERSCHIL(A1;VANDAAG();"ym")&" maanden en "&DATUMVERSCHIL(A1;VANDAAG();"md")&" dag(en)."

 

[don42]

Hoi
#12 dat had ik gevonden op het net 365,25 maar ook hier zitten fouten in en klopt niet altijd
Ik ga nog even zoeken

 

[edmoor]

Heb je een paar datums waar het dan niet klopt?

 

[don42]

Kijk hier eens:
http://www.excelxl.nl/gevorderd/rekenen-met-datums/

 

[VenA]

Bijzonder 'Kijk hier eens:' gebiedende wijs? Heb je ook een antwoord op de vraag van edmoor?

Voor elke cel in kolom C met een datum

Sub VenA()
On Error Resume Next
For Each cl In Columns(3).SpecialCells(2, 1)
 If IsDate(cl) Then cl.Offset(, 2) = "Kijk hier eens:"
Next cl

 

[Ginger]

Er blijkt een wezenlijk verschil te zitten tussen de Worksheet functie en de functie in VBA. Deze geven niet de gelijke uitkomsten. Google dáár maar 'ns op.

 

[edmoor]

Test deze eens:

Public Function Leeftijd(Datum As Variant) As String
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim d As Integer
    Dim dt As Date
    Dim sResult  As String
     
    If Not IsDate(Datum) Then Exit Function
     
    dt = CDate(Datum)
    If dt > Now Then Exit Function
     
    iYear = Year(dt)
    iMonth = Month(dt)
    d = Day(dt)
    iYear = Year(Date) - iYear
    iMonth = Month(Date) - iMonth
    d = Day(Date) - d
     
    If Sgn(d) = -1 Then
        d = 30 - Abs(d)
        iMonth = iMonth - 1
    End If
     
    If Sgn(iMonth) = -1 Then
        iMonth = 12 - Abs(iMonth)
        iYear = iYear - 1
    End If
     
    sResult = iYear & " Jaar " & iMonth & " maanden"
     
    Leeftijd = sResult
End Function

 

[don42]

Hoi edmoor,

sorry dat ik zo laat reageer (Had middagdienst haha)
Ja dit werkt wel
je hebt er weer de 2.0 versie van gemaakt
hey super hier kan ik verde mee
bedankt