为跨闰年的日期计算 Excel 中的 YEARFRAC

Question

如果使用 Excel 的 YEARFRAC(date1,date2,1) 函数，那么 Excel 将根据第二个参数使用基础。如果 date1 和 date2 在同一年，这无关紧要，但如果 date1 是闰年（例如 2020）并且 date2 是非闰年（例如 2021）就很重要

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

比如YEARFRAC(15/12/2020,15/01/2021,1)returns0.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,12,31)," & aDate2 & ",1)")
       result = result + fraction
    Next Y
    yearFracVBA = result
End Function

Answer 1

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

Answer 2

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

=ABS(YEARFRAC(A1,EOMONTH(A1,12-MONTH(A1)),1)+YEAR(B1)-YEAR(A1)-1+YEARFRAC(B1,EOMONTH(B1,-MONTH(B1)),1))

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

为跨闰年的日期计算 Excel 中的 YEARFRAC

Calculating YEARFRAC in Excel for dates spanning leap year

excel

vba

leap-year