簡體   English   中英

VBA - 僅將加權平均UDF用於可見單元格

[英]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.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM