Onun için ekteki örneği kullanabilirsiniz.
Kod:
Public Function YilAyGunFarki(Interval As String, Date1 As Date, Date2 As Date) As Integer
'Diff2Dates fonksiyonundan cevrilerek yazilmistir.
'
'Bu fonksiyon 2 tarih arasındaki Yıl,Ay veya gün farklarını hesaplar.
'
'1.Parametrede Gün için "g", Ay için "a", Yıl için "y" belirtilerek hangi dönemin farkının istendiği belirtilmelidir.
'2. ve 3. Parametrelerde tarihler belirtilir
'
'? YilAyGunFarki("g", #10/09/1971#, #29/09/2008#) = 19
'? YilAyGunFarki("a", #10/09/1971#, #29/09/2008#) = 9
'? YilAyGunFarki("y", #10/09/1971#, #29/09/2008#) = 36
On Error GoTo Hata_YilAyGunFarki
Dim dtTemp As Date
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
'Parametrelerin dogrulugu kontrol ediliyor
If Not (Interval = "g" Or Interval = "a" Or Interval = "y") Then Exit Function
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function
'Tarih1 Tarih2 den küçükse yerleri değiştiriliyor
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
End If
'Yıl, Ay ve Gün farkları bulunuyor
YilAyGunFarki = 0
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - IIf(Format$(Date1, "mmdd") <= Format$(Date2, "mmdd"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - IIf(Format$(Date1, "dd") <= Format$(Date2, "dd"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
lngDiffDays = Abs(DateDiff("d", Date1, Date2))
Date1 = DateAdd("d", lngDiffDays, Date1)
'Parametreye istenen göre sonuç gönderiliyor
Select Case Interval
Case "y"
YilAyGunFarki = lngDiffYears
Case "a"
YilAyGunFarki = lngDiffMonths
Case "g"
YilAyGunFarki = lngDiffDays
End Select
Sonu_Hata_YilAyGunFarki:
Exit Function
Hata_YilAyGunFarki:
Resume Sonu_Hata_YilAyGunFarki
End Function
#7
FarkHesabi.rar
(Dosya Boyutu: 17,08 KB | İndirme Sayısı: 22)
