Question

我对VBA很新，并没有真正尝试过，所以我希望这是一个相对简单的问题，有人可以提供帮助。

我想要的是具有定义范围的函数，然后如果单元格值为= 0，则从该范围中删除该单元格。删除所有零后，运行简单的“If”计算以给出我的结果。

到目前为止我所拥有的内容如下......

Function BestCalc(rng As Range, weighted As Double)

Dim cell As Range

For Each cell In rng
    If cell.Value = 0 Then
        newrng = rng - ActiveCell.rng
    End If
Next
' Gets rid of zeros in range

m = Application.WorksheetFunction.Average(newrng) ' Mean of newrng
s = Application.WorksheetFunction.StDev(newrng) ' St dev of newrng
n = Application.WorksheetFunction.Norm_Inv(0.9999, m, s) ' Inverse of normal approx
v = Application.WorksheetFunction.Var(newrng) ' Variance of newrng
c = Abs((v - m)) ' Absolute value of (variance - mean)

If c <= 20 Then
    BestCalc = n
' Normal distribution

Else
    BestCalc = weighted
' Returns weighted average on sheet

End If

End Function

任何帮助将不胜感激！

谢谢！

Answer 1

我建议你只创建一个非零值数组：

Function BestCalc(rng As Range, weighted As Double)

    Dim cell                  As Range
    Dim vNew()
    Dim lCounter
    Dim m                     As Double
    Dim s                     As Double
    Dim n                     As Double
    Dim v                     As Double
    Dim c                     As Double


    ReDim vNew(1 To rng.Count)

    lCounter = 1

    For Each cell In rng
        If cell.Value2 <> 0 Then
            vNew(lCounter) = cell.Value2
            lCounter = lCounter + 1
        End If
    Next
    ReDim Preserve vNew(1 To lCounter - 1)
    ' Gets rid of zeros in range

    m = Application.WorksheetFunction.Average(vNew)    ' Mean of newrng
    s = Application.WorksheetFunction.StDev(vNew)    ' St dev of newrng
    n = Application.WorksheetFunction.Norm_Inv(0.9999, m, s)    ' Inverse of normal approx
    v = Application.WorksheetFunction.Var(vNew)    ' Variance of newrng
    c = Abs((v - m))    ' Absolute value of (variance - mean)

    If c <= 20 Then
        BestCalc = n
        ' Normal distribution

    Else
        BestCalc = weighted
        ' Returns weighted average on sheet

    End If

End Function

Answer 2

你快到了。您尝试删除范围内的单元格的方式无法通过VBA完成。

我调整了代码并构建了范围的字符串，然后将其传递给Range对象。

Function BestCalc(rng As Range, weighted As Double)

Dim cell As Range
Dim newrng As String

For Each cell In rng
    If cell.Value <> 0 Then
        newrng = newrng & "," & cell.Address
    End If
Next
' Gets rid of zeros in range

newrng = Mid(newrng, 2, Len(newrng) - 1)


m = Application.WorksheetFunction.Average(Range(newrng)) ' Mean of newrng
s = Application.WorksheetFunction.StDev(Range(newrng)) ' St dev of newrng
n = Application.WorksheetFunction.Norm_Inv(0.9999, m, s) ' Inverse of normal approx
v = Application.WorksheetFunction.Var(Range(newrng)) ' Variance of newrng
c = Abs((v - m)) ' Absolute value of (variance - mean)

If c <= 20 Then
    BestCalc = n
' Normal distribution

Else
    BestCalc = weighted
' Returns weighted average on sheet

End If

End Function

从旧范围中删除单元格，然后根据新范围VBA进行计算

2 个答案: