重复收集

我正在尝试创build一个自定义函数来计算基于Excel中单元格区域的“平均每月性能”百分比。 该函数需要忽略具有0值和string"NA"

我没有面临从单元格范围构build集合的任何问题:

 Function KROWPERFMEAN(rng As Range) Dim val As Integer Dim i As Integer Dim cell As Range Dim coll As Collection Set coll = New Collection i = 1 For Each cell In rng If (cell.Value <> "NA" And cell.Value <> 0) Then coll.Add cell.Value End If Next cell 

当我尝试循环集合时,我的代码崩溃了,没有抛出错误,也没有返回结果:

 Dim perf As Variant Dim y As Variant 'loop through collection and get perf For Each y In coll perf = perf + (coll(i) - coll(i + 1)) / coll(i) 'MsgBox (perf) '<-- both of these message boxes fire with exected #s 'MsgBox (i) i = i + 1 Next MsgBox ("This message box never fires with no errors thrown") 'assigned "1" to test, code is never reached KROWPERFMEAN = 1 End Function 

我是如何循环收集的吗?

我尝试了几种解决scheme(改变ytypes,在For Each块中声明variables),但没有成功。

问题在这里:

 perf = perf + (coll(i) - coll(i + 1)) / coll(i) 

用coll(i + 1),一旦你到达集合的末尾,那么你正试图访问一个不存在的成员。 它默默无闻的错误是“下标超出范围”。

不知道你的计算的细节,我最好的猜测是你应该做这样的事情,因为没有第二个值用于计算最后一步。

 Function KROWPERFMEAN(rng As Range) Dim val As Integer Dim i As Integer Dim cell As Range Dim coll As Collection Set coll = New Collection i = 1 For Each cell In rng If (cell.Value <> "NA" And cell.Value <> 0) Then coll.Add cell.Value End If Next cell Dim perf As Variant Dim y As Variant 'loop through collection and get perf For Each y In coll If (i + 1 < coll.Count) Then perf = perf + (coll(i) - coll(i + 1)) / coll(i) End If i = i + 1 Next KROWPERFMEAN = perf End Function