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

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

我想要的是一个具有定义范围的函数，那么如果一个单元格的值是= 0，这个单元格将被从范围中删除。 一旦全零被删除，运行一个简单的“如果”计算给我的结果。

我到目前为止如下…

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

你几乎在那里。 您尝试删除范围内的单元格的方式不能通过VBA来完成。

我调整了你的代码，并构build了范围的string，然后传递给一个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 

Answer 2

我build议你只是创build一个非零值的数组：

 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