Sharing UDF: fDateDiff

Fungsi di bawah bisa dipergunakan untuk semua jenis perhitungan yang melibatkan beda jarak waktu antara dua kejadian.

Berikut functionnya.



Function fDateDiff(ByVal Date1 As Date, _
                    ByVal Date2 As Date, _
                    Optional Date1CountAsDay1 As Boolean = True) _
                    As String

'@2013-07-28
'@EdyWiyono
'edy.wiyono@gmail.com
'http://edy.rumahaccess.com
'ketentuan perhitungan
'jika Date1CountAsDay1 bernilai benar / true artinya tanggal Date1 adalah hari ke 1
'illustrasi
'date    count
'date1   1
'date1+1 2
'date1+2 3
'dst
'jika Date1CountAsDay1 bernilai salah / false artinya tanggal Date1 adalah hari ke 0
'date    count
'date1   0
'date1+1 1
'date1+2 2
'dst

If Date1CountAsDay1 = True Then
    bytMonth = DateDiff("m", Date1 - 1, Date2)
    dtDate = DateAdd("m", bytMonth, Date1 - 1)
    
    If dtDate > Date2 Then
      bytMonth = bytMonth - 1
    End If
    
    bytDayRemain = DateDiff("d", DateAdd("m", bytMonth, Date1 - 1), Date2)
    
Else
    bytMonth = DateDiff("m", Date1, Date2)
    dtDate = DateAdd("m", bytMonth, Date1)
    
    If dtDate > Date2 Then
      bytMonth = bytMonth - 1
    End If
    
    
    bytDayRemain = DateDiff("d", DateAdd("m", bytMonth, Date1), Date2)
End If


bytYear = bytMonth \ 12

bytMonthRemain = bytMonth Mod 12

strYear = Format(bytYear, "00")
strMonth = "" & Format(bytMonthRemain, "00")
strDay = "" & Format(bytDayRemain, "00")
fDateDiff = strYear & strMonth & strDay

End Function

Function fAge(ByVal DateOfBirth As Date) As String
     fAge = fDateDiff(DateOfBirth, Date, False)
End Function

Function fServiceYear(ByVal DateOfEntry As Date) As String
     fServiceYear = fDateDiff(DateOfEntry, Date, False)
End Function

Function fAreaGroup(ByVal SubArea As String) As String
     Select Case SubArea
     Case "BPN", "JKT"
        fAreaGroup = SubArea
     Case Else
        fAreaGroup = "SITE"
     End Select
End Function