如何用VBA自定义函数计算筛选表格可见数值的平均值

原函数存在几处会导致计算错误、运行失效的问题：

• 函数返回值赋值对象错误：函数定义名称为FUNCTION_TABLE_ARRAY_AVERAGE，但原代码将计算结果赋值给未定义的AverVisible变量，函数无法正常返回计算结果
• 变量类型存在溢出风险：计数变量声明为Integer类型，最大支持计数值仅为32767，选定范围行数超出该值时会触发溢出报错
• 变量未初始化：求和变量xTtl未设置初始值，首次累加时可能触发类型不匹配错误
• 数值兼容不足：未对识别到的数值做统一类型转换，部分分数格式、文本存储的合法数值会出现累加异常

修复后的完整代码如下：

Function FUNCTION_TABLE_ARRAY_AVERAGE(Rg As Range) As Variant
' 计算筛选/隐藏后可见单元格平均值，兼容整数、小数、分数各类合法数值
    Dim xCell As Range
    Dim xCount As Long
    Dim xTtl As Double
    Dim cellVal As Double
    
    Application.Volatile
    ' 初始化统计变量
    xTtl = 0
    xCount = 0
    
    ' 排除选定范围中已用区域外的空单元格，减少无效遍历
    Set Rg = Intersect(Rg.Parent.UsedRange, Rg)
    If Rg Is Nothing Then
        FUNCTION_TABLE_ARRAY_AVERAGE = 0
        Exit Function
    End If
    
    For Each xCell In Rg
        ' 仅统计未被隐藏（行高、列宽均大于0）的非空合法数值
        If xCell.ColumnWidth > 0 _
          And xCell.RowHeight > 0 _
          And Not IsEmpty(xCell) Then
            ' 兼容各类可转换为数值的格式，包括分数、文本型数字
            If IsNumeric(xCell.Value) Then
                cellVal = CDbl(xCell.Value)
                xTtl = xTtl + cellVal
                xCount = xCount + 1
            End If
        End If
    Next
    
    ' 无有效统计值时返回0，否则返回计算得到的平均值
    If xCount > 0 Then
        FUNCTION_TABLE_ARRAY_AVERAGE = xTtl / xCount
    Else
        FUNCTION_TABLE_ARRAY_AVERAGE = 0
    End If
End Function

使用注意 #

• 代码需粘贴到VBA工程的标准模块中才可正常调用，单元格内调用格式为=FUNCTION_TABLE_ARRAY_AVERAGE(目标单元格范围)
• 函数自动跳过被筛选隐藏、手动隐藏行/列的单元格，对整数、小数、分数、可转换为数值的文本型数字均能正确统计
• 计数变量调整为Long类型、求和变量调整为Double类型，支持十万级以上行数的统计，无整数溢出风险

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