[英]VBA - use visible cells only for weighted average UDF
為了計算加權平均值,我使用以下簡單的自定義函數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
似乎工作,但我不知道如何整合權重的可見性檢查。
使用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
怎么樣:
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
嘗試這個:
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.