簡體   English   中英

Excel VBA function 加權平均代碼——我該如何改進?

[英]Excel VBA function weighted average code -- how can I improve this?

我需要編寫一個 function,它采用一系列值 (X) 及其相關的不確定性 (E) 並輸出加權平均值。 但是,我無法讓 function 在不產生值錯誤 (#VALUE.) 的情況下循環遍歷數組。 如果只輸入一個單元格作為 X 的輸入,我還希望它只返回 X 的值:這是我目前所處的位置:

' Calculates the weighted average of arrays of values, X, and their errors, E
Option Explicit
Function WAV(X As Variant, E As Variant) As Double
    ' Update values upon changing spreadsheet
    Application.Volatile
    
    ' Test if we have an array or not
    If IsArray(X) And IsArray(E) Then
        Dim W As Double
        Dim WX As Double
        
        W = 0
        WX = 0
        WAV = 20
        
        For myrow = LBound(X,1) To UBound(X,1)
            For mycol = LBound(X, 2) To UBound(X, 2)
            'Test if X and E are both numbers and E > 0
                If (Application.WorksheetFunction.IsNumber(X(myrow, mycol)) = True) And (Application.WorksheetFunction.IsNumber(E(myrow, mycol)) = True) Then
                    If E(myrow, mycol) > 0 Then
                        W = W + 1 / (E(myrow, mycol) ^ 2)
                        WX = WX + X(myrow, mycol) / (E(myrow, mycol) ^ 2)
                    End If
                End If
            Next mycol
        Next
        
        If W > 0 Then
            WAV = WX / W
        End If
    Else
        WAV = X
    End If
End Function

我已經為此掙扎了幾個小時,但無濟於事。 我也是 VBA 的初學者,所以我懷疑我在某個地方犯了一個愚蠢的錯誤。 任何幫助,將不勝感激。

感謝 BigBen 和 ScottCraner 幫助回答這個問題。 這是一個結合了他們兩個建議的工作解決方案:

Option Explicit
Function WAV(X As Variant, E As Variant) As Double
    ' Update values upon changing spreadsheet
    Application.Volatile
    
    ' Test if we have an array or not
    If IsArray(X) And IsArray(E) Then
        ' Change all the ranges into arrays
        Dim XArr() As Variant
        Dim EArr() As Variant
        Dim WArr() As Variant
        
        ' Assign the array values
        XArr = X.Value
        EArr = E.Value
        
        ' Resize the weighting array
        ReDim WArr(LBound(EArr, 1) To UBound(EArr, 1), LBound(EArr, 2) To UBound(EArr, 2))
        
        ' Calculate square inverses of errors
        For myrow = LBound(EArr, 1) To UBound(EArr, 1)
            For mycol = LBound(EArr, 2) To UBound(EArr, 2)
                WArr(myrow, mycol) = 1 / (EArr(myrow, mycol) ^ 2)
            Next mycol
        Next myrow
        
        ' Now calculate the weighted average using sumproduct function
        Dim W As Double
        Dim WX As Double
        
        WX = WorksheetFunction.SumProduct(XArr, WArr)
        W = WorksheetFunction.SumProduct(WArr)
        
        ' Return weighted average
        WAV = WX / W
        
    Else
        ' Return the weighted average
        WAV = X
    End If
End Function

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

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