迭代收集

Question

我正在尝试创建一个自定义函数，以根据Excel中的单元格范围计算“每月平均效果”百分比。该函数需要忽略0值和字符串"NA"。

的单元格

我从单元格范围构建集合时没有遇到任何问题：

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

我是如何循环收集的？

我尝试了几种解决方案（更改y类型，在For Each块中声明变量）但没有成功。

Answer 1

问题在于：

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