VBA - использовать видимые ячейки только для средневзвешенного UDF

Question

Для расчета средневзвешенного я использую следующий простую пользовательскую функцию 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 

Кажется работать, но я не знаю, как интегрировать проверку видимости весов.

Answer 1

Используйте 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 

Answer 2

Как насчет:

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

Попробуйте это:

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