修改EASTER_by_NHarker函数遇单年份输入返回VALUE错误求助

我修改了NHarker的复活节日期VBA函数，使其能处理年份数组——用户输入起止年份后，公式会返回区间内每年的复活节日期数组并自动溢出到对应行。目前多年份输入正常，但当起止年份相同时，工作表函数返回VALUE错误。尝试过添加空元素等方法，还是无法让函数正确返回单年份的复活节日期，求解决。

原函数代码：

'=========================================
Function EASTER_by_NHarker(year As Variant) As Variant
'Based on Claus Tondering algorithm interpretation.
'See https://www.tondering.dk/claus/cal/calendar29.html
'Norman Harker 10-Jul-2004
'
' Modified by Clint E to handle arrays 2023-09-25

  Dim G As Integer: Dim C As Integer: Dim H As Integer
  Dim i As Integer: Dim J As Integer: Dim L As Integer
  Dim EM As Integer: Dim ED As Integer
  Dim Adj1904 As Integer

  Dim YearsArray As Variant
  Dim DatesArray() As Variant
  Dim OutputArray() As Variant
  Dim x As Long, y As Long

  ' Fill the array
  Select Case Application.WorksheetFunction.Count(year)
    Case 0
        Exit Function
    Case 1
        ReDim YearsArray(2, 1)
        YearsArray(1, 1) = year
        YearsArray(2, 1) = 0
    Case Else
        YearsArray = year
  End Select

  ReDim DatesArray(1 To UBound(YearsArray, 1))
  For x = 1 To UBound(YearsArray, 1)

    If Not IsDate("1/1/" & YearsArray(x, 1)) Then
        EASTER_by_NHarker = "Excel Year Limit Error"
        Exit Function
    End If

    G = YearsArray(x, 1) Mod 19
    C = YearsArray(x, 1) \ 100
    H = (C - C \ 4 - (8 * C + 13) \ 25 + 19 * G + 15) Mod 30
    i = H - (H \ 28) * (1 - (29 \ (H + 1)) * ((21 - G) \ 11))
    J = (YearsArray(x, 1) + YearsArray(x, 1) \ 4 + i + 2 - C + C \ 4) Mod 7
    L = i - J
    EM = 3 + (L + 40) \ 44
    ED = L + 28 - (31 * (EM \ 4))
    If ActiveWorkbook.Date1904 = True Then
      Adj1904 = 365 * 4 + 2
    End If
    DatesArray(x) = CDate(Trim((DateSerial(YearsArray(x, 1), EM, ED) - Adj1904)))
  Next

  Select Case Application.WorksheetFunction.Count(year)
    Case 1
        EASTER_by_NHarker = Application.Transpose(Array(DatesArray(1), ""))
    Case Else
        EASTER_by_NHarker = Application.Transpose(DatesArray)
  End Select

End Function
'=========================================

问题分析 #

1. 单年份输入时，代码构建了包含2个元素的YearsArray（第二个元素为0），循环处理时会校验1/1/0的有效性，显然这不是有效日期，直接触发错误返回，导致函数提前退出。
2. 单年份返回时的数组包含空元素，不符合Excel溢出数组的预期格式，也会引发VALUE错误。

修复后的代码 #

'=========================================
Function EASTER_by_NHarker(year As Variant) As Variant
'Based on Claus Tondering algorithm interpretation.
'Norman Harker 10-Jul-2004
'
' Modified by Clint E to handle arrays 2023-09-25
' Fixed single-year array return error

  Dim G As Integer: Dim C As Integer: Dim H As Integer
  Dim i As Integer: Dim J As Integer: Dim L As Integer
  Dim EM As Integer: Dim ED As Integer
  Dim Adj1904 As Integer: Adj1904 = 0 ' 显式初始化，避免未赋值问题

  Dim YearsArray As Variant
  Dim DatesArray() As Variant
  Dim x As Long

  ' 构建年份数组
  Select Case Application.WorksheetFunction.Count(year)
    Case 0
        Exit Function
    Case 1
        ' 单年份时直接创建单元素数组，避免无效年份
        ReDim YearsArray(1 To 1, 1 To 1)
        YearsArray(1, 1) = year
    Case Else
        YearsArray = year
  End Select

  ReDim DatesArray(1 To UBound(YearsArray, 1))
  For x = 1 To UBound(YearsArray, 1)
    ' 校验年份有效性
    If Not IsDate("1/1/" & YearsArray(x, 1)) Then
        EASTER_by_NHarker = "Excel Year Limit Error"
        Exit Function
    End If

    ' 复活节日期计算逻辑
    G = YearsArray(x, 1) Mod 19
    C = YearsArray(x, 1) \ 100
    H = (C - C \ 4 - (8 * C + 13) \ 25 + 19 * G + 15) Mod 30
    i = H - (H \ 28) * (1 - (29 \ (H + 1)) * ((21 - G) \ 11))
    J = (YearsArray(x, 1) + YearsArray(x, 1) \ 4 + i + 2 - C + C \ 4) Mod 7
    L = i - J
    EM = 3 + (L + 40) \ 44
    ED = L + 28 - (31 * (EM \ 4))
    
    ' 1904日期系统调整
    If ActiveWorkbook.Date1904 = True Then
      Adj1904 = 365 * 4 + 2
    End If
    DatesArray(x) = CDate(DateSerial(YearsArray(x, 1), EM, ED) - Adj1904)
  Next

  ' 返回对应格式的数组
  Select Case Application.WorksheetFunction.Count(year)
    Case 1
        ' 单年份返回单个日期的转置数组，符合溢出要求
        EASTER_by_NHarker = Application.Transpose(Array(DatesArray(1)))
    Case Else
        EASTER_by_NHarker = Application.Transpose(DatesArray)
  End Select

End Function
'=========================================

关键修改点 #

• 单年份输入时，不再构建包含无效元素的数组，直接创建仅含目标年份的单元素数组，避免循环处理无效年份触发错误。
• 显式初始化Adj1904为0，防止未进入1904日期系统分支时变量未赋值导致的日期计算错误。
• 单年份返回时，仅返回包含单个日期的转置数组，符合Excel溢出数组的格式要求，消除VALUE错误。

内容的提问来源于stack exchange，提问作者clintonpe