yaşhesapla, yaş hesaplamak

[mersilen]

selam
başka bir yerde bulduğum yaş hesaplamak ile ilgili iki çalışmayı ekliyorum
beelki işe yarar
1. Tarkan Vural yaşhesapla KTF oluşturmuş

Function yashesapla(deger As Range) As String
If deger = Empty Then GoTo 10
bugun = CLng(Date): yas = CLng(CDate(deger))
If yas > bugun Then
10 yashesapla = "Hatalı Tarih"
Exit Function
End If
farkyas = CLng(Date) - CLng(CDate(deger))
buyil = Year(Date): bulyas = CLng(Year(deger)): yas = buyil - bulyas
If Month(Date) < Month(deger) Then: yasi = yas - 1: Else: yasi = yas
If yas > 0 Then
For i = 0 To yas - 1
tarih1 = DateSerial(Year(Date) - i, Month(Date), Day(Date))
tarih2 = DateSerial(Year(Date) - (i + 1), Month(Date), Day(Date))
fark = CLng(tarih1 - tarih2)
If fark = 365 Or fark = 366 Then
If farkyas >= 365 Then
farkyas = farkyas - fark
kalangun = farkyas
Else
kalangun = farkyas
Exit For
End If
End If
Next i
Select Case kalangun
Case Is >= 30
ay = CInt(kalangun / 30)
Case Else
ay = 0
End Select
If artikyil = 365 Then
For t = 0 To ay - 1
gecicitarih1 = DateSerial(Year(Date), Month(Date) - t, Day(Date))
gecicitarih2 = DateSerial(Year(Date), Month(Date) - (t + 1), Day(Date))
gecicisay = CLng(gecicitarih1 - gecicitarih2)
If gecicisay <= kalangun Then
kalangun = kalangun - gecicisay
Else
ay = t
Exit For
End If
Next t
End If
gun = kalangun
yil = yasi
Else
yil = 0: ay = 0: gun = farkyas
End If
yashesapla = yil & " Yıl " & ay & " Ay " & gun & " Gün"
End Function

Function artikyil() As Integer
t1 = DateSerial(Year(Date) - i, Month(Date), Day(Date))
t2 = DateSerial(Year(Date) - (i + 1), Month(Date), Day(Date))
artikyil = CLng(t1 - t2)
End Function

2.Selami Güzel in oluşurtuğu yerleşik fonksiyon

=ETARİHLİ(A1;A2;"y") & " YIL " & ETARİHLİ(A1;A2;"ym") & " AY "& ETARİHLİ(A1;A2;"MD") & " GÜN"

A1 hücresine ilk tarih yazılıyor
A2 hücresine son " = BUGÜN() " yazılacak

 

[Zeki Gürsoy]

Merhaba; bu da benden...

Function DateDiffA(kucuk As Date, buyuk As Date) As String
Dim yil As Integer, ay As Byte, gun As Byte

    If Day(buyuk) < Day(kucuk) Then
    
        gun = buyuk - DateSerial(Year(buyuk), Month(buyuk) - 1, Day(buyuk))
        gun = gun + Day(buyuk) - Day(kucuk)
        
        If Month(buyuk) <= Month(kucuk) Then
            yil = (Year(buyuk) - 1) - Year(kucuk)
            ay = 12 + (Month(buyuk) - 1) - Month(kucuk)
        Else
            yil = Year(buyuk) - Year(kucuk)
            ay = Month(buyuk) - Month(kucuk) - 1
        End If
        
    Else
    
        gun = Day(buyuk) - Day(kucuk)
        
        If Month(buyuk) < Month(kucuk) Then
            yil = (Year(buyuk) - 1) - Year(kucuk)
            ay = 12 + Month(buyuk) - Month(kucuk)
        Else
            yil = Year(buyuk) - Year(kucuk)
            ay = Month(buyuk) - Month(kucuk)
        End If
        
    End If

DateDiffA = yil & " YIL " & ay & " AY " & gun & " GÜN"
End Function

 

[mersilen]

Zeki hocam katkılarınız için teşekkür ederim

Daha kısa bir KTF oluşturmak mantığı ile
ben yerleşik fonksiyonun macro kodlarını öğrenmek için kaydını yaptım ve çalıştırdım, bir sorunlada karşılaşmadım.Ama bu macro kodlarındaki formülü KTF ye aktardığım zaman hata veriyor, değerlendirebilir misiniz?

=ETARİHLİ(A1;A2;"y") & " YIL " & ETARİHLİ(A1;A2;"ym") & " AY "& ETARİHLİ(A1;A2;"MD") & " GÜN"

Sub Makro222()
' Makro222 Makro
' Range("A5").Select
ActiveCell.FormulaR1C1 = _
"=DATEDIF(R[-4]C,R[-3]C,""y"")&"" YIL ""& DATEDIF(R[-4]C,R[-3]C,""ym"")&"" AY ""& DATEDIF(R[-4]C,R[-3]C,""MD"")&"" GÜN """
Range("A6").Select
End Sub

A1:doğum tarihi
A2:bugün

Function hesaplayas(doğum tarihi, bugün As Range) As String

hesaplayas=DATEDIF(R[-4]C,R[-3]C,""y"")&"" YIL ""& DATEDIF(R[-4]C,R[-3]C,""ym"")&"" AY ""& DATEDIF(R[-4]C,R[-3]C,""MD"")&"" GÜN ""

End function

sorun
doğum tarihi: R[-4]C
bugün:R[-3]C

formüldeki yerlerine nasıl yazılacak
bu yapılırsa çok kısa bir KTF yazılmış olur

 

[Zeki Gürsoy]

Merhaba,

A1 = Doğum tarihi,
A2 = Bugün

=ETARİHLİ(A1;A2;"Y")& " YIL "&ETARİHLİ(A1;A2;"YM")& " AY "&ETARİHLİ(A1;A2;"MD")& " GÜN "

Function ETARİH(KÜÇÜK_TARİH As Range, BÜYÜK_TARİH As Range) As String
ETARİH = Evaluate("DateDif(" & KÜÇÜK_TARİH.Address & "," & BÜYÜK_TARİH.Address & ", ""y"")") & " YIL "
ETARİH = ETARİH & Evaluate("DateDif(" & KÜÇÜK_TARİH.Address & "," & BÜYÜK_TARİH.Address & ", ""ym"")") & " AY "
ETARİH = ETARİH & Evaluate("DateDif(" & KÜÇÜK_TARİH.Address & "," & BÜYÜK_TARİH.Address & ", ""md"")") & " GÜN"
End Function

 

[mersilen]

zeki bey tekrar tşk
güzel olmuş

 

[Merhum İdris SERDAR]

.

Bir örmekte benden.

Function YAS(dTarih As Date, sTarih As Date) As String
    Dim Y As Integer
    Dim A As Integer
    Dim G As Integer
    Dim elde As Date
    elde = DateSerial(Year(sTarih), Month(dTarih), Day(dTarih))
    Y = Year(sTarih) - Year(dTarih) + (elde > sTarih)
    A = Month(sTarih) - Month(dTarih) - (12 * (elde > sTarih))
    G = Day(sTarih) - Day(dTarih)
    If G < 0 Then
        A = A - 1
        G = Day(DateSerial(Year(sTarih), Month(sTarih) + 1, 0)) + G + 1
    End If
    YAS = Y & " Yıl " & A & " Ay " & G & " Gün"
End Function

Formül:

=yas(A1;A2)

.

 

[mersilen]

zeki hocanın formülünü affına sığınarak kendime göre değiştirdim

Function ETARİH1(A1 As Range, A2 As Range) As String

ETARİH1 = Evaluate("DateDif(" & A1.Address & "," & A2.Address & ", ""y"") & "" YIL "" & DateDif(" & A1.Address & "," & A2.Address & ", ""ym"")& "" AY "" & DateDif(" & A1.Address & "," & A2.Address & ", ""md"") & "" GÜN""")

End Function