Excel 365 VBA自定义函数RealDate无法正确返回动态数组

问题背景 #

我使用Excel 365编写了RealDate自定义函数，目的是让SumProduct能处理包含公式生成空单元格的数组——当公式返回""时，SumProduct处理这类空单元格存在底层问题。

自定义函数代码 #

Public Function RealDate(Zelle As Range) As Variant
' Returns the corresponding array of dates as long as the cell contains a valid date
' Returns 1.1.1900 for all the cells with invalid formats or dates

    Dim c As Range
    Dim b As Boolean, i As Integer, MinDate As Date
    Dim outputArray As Variant

    MinDate = "1.1.1900"                        ' This should be the value 0 in integers
    ReDim outputArray(1 To Zelle.Count)
    On Error GoTo Continue

    i = 0
    For Each c In Zelle.Cells
        i = i + 1
        outputArray(i) = MinDate
        b = IsDate(c.Value) And (Year(c.Value) >= 1900) And (Day(c.Value) > 0)
        If b Then outputArray(i) = c.Value
    Continue:
        MsgBox outputArray(i)
        Next c
 
    RealDate = outputArray
    ' Unfortunately, this statement does not work - what is returned is a vector of mainly integer 0 or 01.01.1900

End Function

遇到的问题 #

函数返回的结果要么是01.01.1900要么是00.01.1900，但消息框显示outputArray的所有值都是正确的（比如01.01.90、31.01.13、14.01.14、29.08.23），且动态数组大小为4（符合预期）。看起来RealDate无法正确传递outputArray中的值。

期望：函数能正确返回outputArray中存储的值。

已尝试的方法 #

• 改为RealDate = VSTACK(outputArray)：返回3个#Value错误和1个00.01.1990，且不再弹出消息框
• 改为RealDate(1) = outputArray(1)：同样有问题，也不再弹出消息框

问题原因及解决方案 #

核心问题 #

1. 错误处理逻辑干扰：On Error GoTo Continue会捕获所有错误，且标签位置错误，可能导致部分值未正确赋值；同时Excel自定义函数（UDF）中禁止使用MsgBox，这也是修改代码后弹窗消失的原因。
2. 数组结构不匹配：返回一维数组与Excel单元格区域的二维结构不兼容，导致值显示异常。
3. 日期类型转换问题：直接使用Date类型存储数组值，返回时易触发Excel的自动类型转换，导致日期显示错误。

修正后的代码 #

Public Function RealDate(Zelle As Range) As Variant
    ' 返回有效日期的数组，无效日期/空单元格返回1900-01-01（对应Excel序列号1）
    Dim c As Range
    Dim i As Integer, MinDate As Double
    Dim outputArray As Variant
    
    ' 用日期序列号存储，避免类型转换异常
    MinDate = DateSerial(1900, 1, 1)
    ' 创建与输入区域结构一致的二维数组
    ReDim outputArray(1 To Zelle.Rows.Count, 1 To Zelle.Columns.Count)
    
    i = 0
    For Each c In Zelle.Cells
        i = i + 1
        ' 计算二维数组的行、列索引
        Dim rowIdx As Integer, colIdx As Integer
        rowIdx = (i - 1) \ Zelle.Columns.Count + 1
        colIdx = (i - 1) Mod Zelle.Columns.Count + 1
        
        ' 默认赋值最小日期
        outputArray(rowIdx, colIdx) = MinDate
        
        ' 显式判断空值与有效日期
        If c.Value <> "" And IsDate(c.Value) Then
            Dim cellDate As Date
            cellDate = CDate(c.Value)
            If Year(cellDate) >= 1900 Then
                outputArray(rowIdx, colIdx) = cellDate
            End If
        End If
    Next c
    
    RealDate = outputArray
End Function

关键修改点 #

• 二维数组返回：匹配Excel单元格区域的二维结构，避免一维数组的方向适配问题。
• 日期序列号存储：用Double类型存储日期序列号，避免Date类型在数组返回时的转换异常。
• 移除无效代码：删除UDF中禁止的MsgBox和错误捕获逻辑，改用显式条件判断处理空值与无效日期。
• 索引计算优化：将遍历计数转换为二维数组的行、列索引，确保返回数组与输入区域结构完全对应。

使用说明 #

在Excel单元格中输入=RealDate(A1:A4)（替换为目标区域），函数会返回对应大小的动态数组：有效日期保持原样，空单元格或无效日期返回1900-01-01，此时SumProduct可正常处理该数组。

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