Yaş Kontrol etme

[Crazy Drake]

    Dim DoğumGünü As Date
    Dim Yaş
    DoğumGünü = Range("A1").Value
    Yaş = FormatNumber(DateDiff("m", DoğumGünü, Now) / 12, 1)
    If Yaş < 18 Then
        MsgBox "Yaş: " & Yaş & vbLf & "18 yaşıdan küçük"
    End If

kodunu kullanarak a1 hücresine girilen doğum tarihinin 18 yaşından büyük olup olmadığını kontrol ediyorum ancak aya göre kontrol ettiği için doğru sonuç veremiyor bunu günüde kontrol edecek şekilde nasıl düzenleriz.

 

[Merhum İdris SERDAR]

Aşağıdaki şekilde deneyin.

Dim DoğumGünü As Date
   Dim Yaş
    DoğumGünü = Range("A1").Value
    Yaş = FormatNumber((Now() - DoğumGünü) / 365.25, 0)
    If Yaş < 18 Then
        MsgBox "Yaş: " & Yaş & vbLf & "18 yaşından küçük"
    End If

End Sub

.

 

[Crazy Drake]

yaş 19 çıkmasına rağmen uyarı veriyor ve günlük hassaslığı yok

 

[Merhum İdris SERDAR]

yaş 19 çıkmasına rağmen uyarı veriyor ve günlük hassaslığı yok

Bir de böyle deneyin.

 Dim Yaş
    DoğumGünü = Range("A1").Value
    Yaş = FormatNumber((Now() - DoğumGünü / 365.25, 0)
    If Yaş < 18 Then
        MsgBox "Yaş: " & Yaş & vbLf & "18 yaşından küçük"
    End If

End Sub

.

 

[Crazy Drake]

Yine Olmadı ancak Fonksiyonlarıda katarak hallettim

hücrede bugünden doğum tarhini çıkartıp ao1 yazdım ve ao1 hücresi 6575 değerinden azsa uyarı verecek şekildew ayrladım

 

[Merhum İdris SERDAR]

Yine Olmadı ancak Fonksiyonlarıda katarak hallettim

Bende çalıştı ama. Yine de nasıl çözdüğünüzü ekleseniz de biz de yararlansak.

Uğraştığımızın teşekkürü de kenarda kalsın.

.

 

[Zeki Gürsoy]

Merhaba,

Bunu deneyin...

Function YAŞ(doğum As Date, Optional şimdi As Date) As Byte

Dim yil As Integer, ay As Integer, gun As Integer

şimdi = IIf(şimdi = Empty, Date, şimdi)

yil = Year(şimdi) - Year(doğum)
ay = Month(şimdi) - Month(doğum)
gun = Day(şimdi) - Day(doğum)

Select Case yil
    Case Is <= 0: YAŞ = 0
    Case Else: YAŞ = IIf(ay > 0 Or (ay = 0 And gun > 0), yil, yil - 1)
End Select

End Function

 

[Crazy Drake]

çok özür diliyorum yazdım sanıyordum. Çok teşekkür ederim örnek dosyayı ekledim