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

Question

For calculating a weighted average I use the following simple custom function VBA code:

Function wgtavg(values As Range, weights As Range)

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

End Function

I want a function that considers only visible cells - Can anyone suggest a solution?

edit: I figured this out:

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

Seems to work but I dont know how to integrate the visibility check of the weights.

Answer 1

Use SpecialCells() method

Function wgtavg(values As Range, weights As Range)

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

End Function

Answer 2

How about:

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

Answer 3

Try this:

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