在Excel中计算跨越闰年的日期的YEARFRAC

Question

如果使用Excel的< code>YEARFRAC(date1，date2，1)函数，则Excel将按照第二个参数使用基数。如果日期1和日期2在同一年，这没有关系，但如果日期1是闰年(例如2020年)而日期2是非闰年(例如2021年)，这就有关系了

我认为更准确的计算应该考虑到< code>date1的基数可能不同于< code>date2的基数。

例如，< code>YEARFRAC(15/12/2020，15/01/2021，1)返回< code>0.08493151，但实际计算结果是< code >(31/12/2020-15/12/2020)/366(15/01/2020-31/12/2020)/365 = 0.084811737

我在VBA中实现了以下内容。有人有更好的方法吗（在Excel或VBA中）？（我不希望对我匆忙的VBA代码进行细微的改进）

使用< code>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,12,31)," & aDate2 & ",1)")
       result = result + fraction
    Next Y
    yearFracVBA = result
End Function

Answer 1

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

=ABS（A1，12个月，1）年（B1）-年（A1）-1年（B1，EO月（B1，1个月）， 1））

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

Answer 2

以下代码不需要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, 12, 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