VBA - 仅将加权平均UDF用于可见单元格

时间:2016-11-13 13:35:10

标签: vba excel-vba function average excel

为了计算加权平均值,我使用以下简单的自定义函数VBA代码:

Function wgtavg(values As Range, weights As Range)

    wgtavg = WorksheetFunction.SumProduct(values, weights) / WorksheetFunction.Sum(weights)

End Function

我想要一个仅考虑可见细胞的功能 - 任何人都可以提出解决方案吗?

编辑: 我想出了这个:

Function wgtavg(values As Range, weights As Range)

    counter = 0
    xSumproduct = 0
    xSum = 0
    For Each xVal In values
      counter = counter + 1
    If xVal.Rows.Hidden = False Then
    If xVal.Columns.Hidden = False Then

        xSumproduct = xSumproduct + (xVal * weights(counter))
        xSum = xSum + weights(counter)
    End If
    End If
        Next

    wgtavg = xSumproduct / xSum

End Function

似乎工作但我不知道如何整合权重的可见性检查。

3 个答案:

答案 0 :(得分:0)

使用SpecialCells()方法

Function wgtavg(values As Range, weights As Range)

    wgtavg = WorksheetFunction.SumProduct(values.SpecialCells(xlCellTypeVisible), weights.SpecialCells(xlCellTypeVisible)) / WorksheetFunction.Sum(weights.SpecialCells(xlCellTypeVisible)))

End Function

答案 1 :(得分:0)

怎么样:

Function wgtavg(values As Range, weights As Range) As Double
    Dim i As Long
    For i = 1 To values.Count
        If values(i).EntireRow.Hidden = False Then
            wgtavg = wgtavg + values(i) * weights(i)
        End If
    Next i

    wgtavg = wgtavg / Application.WorksheetFunction.Subtotal(109, weights)
End Function

答案 2 :(得分:0)

试试这个:

Function wgtavg(values As Range, weights As Range) As Variant
    Dim counter As Long
    Dim xSumproduct As Double
    Dim xSum As Double

    'Error if there are different numbers of values and weights
    If values.Cells.Count <> weights.Cells.Count Then
        wgtavg = CVErr(xlErrRef)
        Exit Function
    End If

    'Initialise SumProduct and Sum (just in case Dim no longer does so)
    xSumproduct = 0
    xSum = 0

    'Loop through each cell
    For counter = 1 to values.Cells.Count
        'Check to if value or weight is hidden
        If Not (values(counter).Rows.Hidden Or _
                values(counter).Columns.Hidden Or _
                weights(counter).Rows.Hidden Or _
                weights(counter).Columns.Hidden) Then

            'Error if either value or weight is error
            If IsError(values(counter)) Or _
               IsError(weights(counter)) Then
                wgtavg = CVErr(xlErrNA)
                Exit Function
            End If

            'Error if either value or weight is not numeric
            If Not (IsNumeric(values(counter).Value) And _
                    IsNumeric(weights(counter).Value)) Then
                wgtavg = CVErr(xlErrNA)
                Exit Function
            End If

            'Maintain running total of SumProduct and Sum
            xSumproduct = xSumproduct + values(counter).Value * _
                                        weights(counter).Value
            xSum = xSum + weights(counter).Value
        End If
    Next
    'Calculate weighted average
    wgtavg = xSumproduct / xSum
End Function