Excel-VBA新手求助：编写加权几何平均自定义函数遇求和难题

嘿，作为VBA新手遇到求和的问题太正常了，我来帮你把这个函数捋顺！首先得指出你现有代码里的几个关键问题：

• 函数参数定义成了单个Double类型，但我们需要接收单元格区域（比如一整列/行的权重或数值），所以参数类型得改成Range
• 直接硬编码操作Range("A1")不是自定义函数的正确姿势——自定义函数应该专注于计算逻辑，最后返回结果即可，不要直接修改工作表内容
• 求和部分需要遍历每一组对应的权重和数值，逐个计算累加，而不是生硬调用工作表的Sum函数

下面是完整的可运行代码，我加了注释帮你理解每一步：

Function GEOWAMC(WiRange As Range, MiRange As Range) As Double
    Dim WiCell As Range, MiCell As Range
    Dim sumWiLnMi As Double, sumWi As Double
    Dim i As Integer
    
    ' 初始化两个累加变量：一个存Wi*Ln(Mi)的总和，一个存Wi的总和
    sumWiLnMi = 0
    sumWi = 0
    
    ' 先检查权重区域和数值区域的单元格数量是否一致，不一致就返回错误
    If WiRange.Cells.Count <> MiRange.Cells.Count Then
        GEOWAMC = CVErr(xlErrValue)
        Exit Function
    End If
    
    ' 遍历每一组权重和数值
    For i = 1 To WiRange.Cells.Count
        Set WiCell = WiRange.Cells(i)
        Set MiCell = MiRange.Cells(i)
        
        ' 跳过空单元格或者非数值的内容，避免计算出错
        If IsNumeric(WiCell.Value) And IsNumeric(MiCell.Value) Then
            ' 确保数值是正数，因为Ln(0/负数)会报错
            If MiCell.Value > 0 Then
                sumWi = sumWi + WiCell.Value
                sumWiLnMi = sumWiLnMi + WiCell.Value * WorksheetFunction.Ln(MiCell.Value)
            End If
        End If
    Next i
    
    ' 避免除以0的情况，权重总和为0就返回错误
    If sumWi = 0 Then
        GEOWAMC = CVErr(xlErrDiv0)
    Else
        ' 用Exp计算最终的加权几何平均
        GEOWAMC = WorksheetFunction.Exp(sumWiLnMi / sumWi)
    End If
End Function

怎么用这个函数？ #

在Excel单元格里直接输入：
=GEOWAMC(你的权重区域, 你的数值区域)
比如你的权重在A2:A4，数值在B2:B4，就输入=GEOWAMC(A2:A4, B2:B4)

额外注意点 #

• 如果权重和数值区域的单元格数量不一样，函数会返回#VALUE!错误
• 如果所有权重的总和为0，会返回#DIV/0!错误
• 如果数值里包含0或者负数，对应的那组数据会被跳过不参与计算；你也可以修改代码，遇到这类数值直接返回错误，具体看你的需求

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