Function DATEDIF2(date1 As Date, date2 As Date, interval As String)
If date1 > date2 Then GoTo Handler
On Error Resume Next
interval = UCase(interval)
date1a = DateSerial(Year(date1), Month(date1), 1)
date1b = DateSerial(Year(date1), Month(date1) + 1, 0)
date2a = DateSerial(Year(date2), Month(date2), 1)
date2b = DateSerial(Year(date2), Month(date2) + 1, 0)
v_return = ""
If interval = "Y" Then
v_return = Format(date2, "YYYYMMDD") - Format(date1, "YYYYMMDD")
v_return = Fix(v_return / 10000)
End If
If interval = "M" Then
If date1 = date1b And date2 = date2b Then
v_return = DateDiff("m", date1a, date2a)
Else
If Day(date1) > Day(date2) Then
v_return = DateDiff("m", date1a, date2a) - 1
Else
v_return = DateDiff("m", date1a, date2a)
End If
End If
End If
If interval = "D" Then
v_return = date2 - date1
End If
If interval = "MD" Then
If Day(date1) <= Day(date2) Then
v_return = Day(date2) - Day(date1)
Else
If date1 = date1b Then
v_return = Day(date2)
Else
day0 = Day(date1) + 1
Do
day0 = day0 - 1
date0 = DateValue(Format(DateAdd("m", -1, date2), "yyyy/mm") & "/" & day0)
If IsDate(date0) Then Exit Do
Loop
date0b = DateSerial(Year(date0), Month(date0) + 1, 0)
v_return = (date0b - date0) + Day(date2)
End If
End If
End If
If interval = "YM" Then
If Day(date1) <= Day(date2) Then
v_return = DateDiff("m", date1a, date2a) Mod 12
Else
v_return = DateDiff("m", date1a, date2a) Mod 12 - 1
End If
If v_return < 0 Then v_return = 11
End If
If interval = "YD" Then
If Year(date1) = Year(date2) Then
v_return = date2 - date1
Else
If Format(date1, "mmdd") = "0229" And Format(date2, "mmdd") = "0228" Then
v_return = 365
Else
mmdd0 = Format(date1, "mmdd") + 1
Do
mmdd0 = Right("0" & mmdd0 - 1, 4)
If mmdd0 <= Format(date2, "mmdd") Then
date0 = DateValue(Format(Year(date2) & "/" & Left(mmdd0, 2) & "/" & Right(mmdd0, 2)))
Else
date0 = DateValue(Format(Year(date2) - 1 & "/" & Left(mmdd0, 2) & "/" & Right(mmdd0, 2)))
End If
If IsDate(date0) Then Exit Do
Loop
v_return = date2 - date0
End If
End If
End If
DATEDIF2 = v_return
Exit Function
Handler:
DATEDIF2 = CVErr(xlErrNum)
End Function
|