在Excel中计算跨越leap年的YEARFRAC

如何解决在Excel中计算跨越leap年的YEARFRAC

如果使用Excel的YEARFRAC(date1,date2,1)函数，则Excel将根据第二个参数使用基数。 date1和date2是否在同一年并不重要，但date1是a年（例如2020）而date2是非-年（例如2021）也很重要

我认为更准确的计算应考虑到date1的基础可以与date2的基础不同。

例如，YEARFRAC(15/12/2020,15/01/2021,1)返回0.08493151 但是真正的计算是(31/12/2020-15/12/2020)/366 + (15/01/2020-31/12/2020)/365 = 0.084811737

我在VBA中实现了以下功能。有没有人从根本上有更好的方法（在Excel或VBA中）？（我并不是想对我急于完成的VBA代码进行小的改进）

使用yearFracVBA("AA1","AA2")

调用

Function yearFracVBA(aDate1,aDate2)
    result = 0
    y1 = Application.Evaluate("=YEAR(" & aDate1 & ")")
     y2 = Application.Evaluate("=YEAR(" & aDate2 & ")")
     
    For Y = y1 To y2
       fraction = 0
       If Y = y1 And Y = y2 Then fraction = Application.Evaluate("=YEARFRAC(" & aDate1 & "," & aDate2 & ",1)")
       If Y = y1 And Y < y2 Then fraction = Application.Evaluate("=YEARFRAC(" & aDate1 & ",DATE(YEAR(" & aDate1 & "),12,31),1)")
       If Y > y1 And Y < y2 Then fraction = 1
       If Y > y1 And Y = y2 Then fraction = Application.Evaluate("=YEARFRAC(DATE(YEAR(" & aDate2 & ")-1,1)")
       result = result + fraction
    Next Y
    yearFracVBA = result
End Function

解决方法

以下代码不需要Excel。它可以在任何VBA应用程序中使用：

Option Explicit

Public Function YearFracActual(ByVal aDate1 As Date,ByVal aDate2 As Date) As Double
    Dim lowerDate As Date
    Dim upperDate As Date
    Dim year1 As Integer
    Dim year2 As Integer
    
    'Get dates in order
    If aDate1 > aDate2 Then
        lowerDate = aDate2
        upperDate = aDate1
    Else
        lowerDate = aDate1
        upperDate = aDate2
    End If
    
    'Round down (floor) - exclude any time (hours,minutes,seconds)
    lowerDate = VBA.Int(lowerDate)
    upperDate = VBA.Int(upperDate)
    
    'Get years
    year1 = Year(lowerDate)
    year2 = Year(upperDate)
    
    If year1 = year2 Then
        YearFracActual = (upperDate - lowerDate) / GetDaysInYear(year1)
    Else
        Dim lowerFrac As Double
        Dim upperFrac As Double
        Dim midFrac As Double
    
        lowerFrac = (DateSerial(year1,12,31) - lowerDate) / GetDaysInYear(year1)
        midFrac = year2 - year1 - 1
        upperFrac = (upperDate - DateSerial(year2 - 1,31)) / GetDaysInYear(year2)
        
        YearFracActual = lowerFrac + midFrac + upperFrac
    End If
End Function

Private Function GetDaysInYear(ByVal year_ As Integer) As Integer
    If IsLeapYear(year_) Then
        GetDaysInYear = 366
    Else
        GetDaysInYear = 365
    End If
End Function

Private Function IsLeapYear(ByVal year_ As Integer) As Boolean
    If year_ Mod 400 = 0 Then
        IsLeapYear = True
    ElseIf year_ Mod 100 = 0 Then
        IsLeapYear = False
    Else
        IsLeapYear = (year_ Mod 4 = 0)
    End If
End Function

如果您不想使用VBA，则可以在Excel中使用以下公式：

map

其中A1和B1是包含2个日期的单元格