标签:VBA,自定义函数
大家知道,DATEDIF函数虽然可用,但已不在Excel插入函数可搜索的范围内了。
下面是在excelfox.com看到的一个自定义函数,虽然还存在Bug,但已经很不错了。
代码语言:javascript复制Function xlDATEDIF(ByVal StartDate As Date, ByVal EndDate As Date,Interval As String) As Variant
Dim NumOfYears As Long
Dim NumOfMonths As Long
Dim NumOfWeeks As Long
Dim NumOfDays As Long
Dim DaysDiff As Long
Dim ydDaysDiff As Long
Dim TSerial1 As Double
Dim TSerial2 As Double
If StartDate > EndDate Then
Err.Raise 5
Exit Function
End If
If InStr(1, "Y M D",Interval, vbTextCompare) Then
Select Case UCase(Interval)
Case "Y":xlDATEDIF = DateDiff("yyyy", StartDate, EndDate)
Case "M":xlDATEDIF = DateDiff("m", StartDate, EndDate) 1
Case "D":xlDATEDIF = EndDate - StartDate
End Select
Else
NumOfYears =DateDiff("yyyy", StartDate, EndDate)
DaysDiff = EndDate -StartDate
TSerial1 =TimeSerial(Hour(StartDate), Minute(StartDate), Second(StartDate))
TSerial2 =TimeSerial(Hour(EndDate), Minute(EndDate), Second(EndDate))
If 24 * (TSerial2 -TSerial1) < 0 Then EndDate = DateAdd("d", -1, EndDate)
StartDate =DateSerial(Year(EndDate), Month(StartDate), Day(StartDate))
If StartDate > EndDateThen
StartDate =DateAdd("yyyy", -1, StartDate)
NumOfYears = NumOfYears- 1
End If
ydDaysDiff = EndDate -StartDate
NumOfMonths =DateDiff("m", StartDate, EndDate) 1
StartDate =DateSerial(Year(EndDate), Month(EndDate), Day(StartDate))
If StartDate > EndDateThen
StartDate =DateAdd("m", -1, StartDate)
NumOfMonths = NumOfMonths- 1
End If
NumOfDays =Abs(DateDiff("d", StartDate, EndDate))
Select Case UCase(Interval)
Case "YM":xlDATEDIF = NumOfMonths
Case "YD":xlDATEDIF = ydDaysDiff
Case "MD":xlDATEDIF = NumOfDays
Case Else
End Select
End If
End Function
使用方法:
假设日期在单元格A1和A2中,则公式:
代码语言:javascript复制=xlDATEDIF(A1,A2,"y")
返回两日期相差的年数。
代码语言:javascript复制=xlDATEDIF(A1,A2,"m")
返回两日期相差的月份数。
代码语言:javascript复制=xlDATEDIF(A1,A2,"d")
返回两日期相差的天数。
代码语言:javascript复制=xlDATEDIF(A1,A2,"ym")
返回两日期相差的月份数,与年无关。
代码语言:javascript复制=xlDATEDIF(A1,A2,"yd")
返回两日期相差的天数,与年无关。
代码语言:javascript复制=xlDATEDIF(A1,A2,"md")
返回两日期相差的天数,与年月无关。