当范围有50,000行要计算时，UDF完全无效
我在下面创建了一个UDF，希望它能很好地工作。其思想是计算变量的加权平均值(情况需要满足标准)。但是当范围包含50,000行时(例如A1:A50000)，这个宏就死了。Excel只是在几个小时后继续运行，没有响应。我认为VBA中的数组足以处理50,000行。我在想，在使用了这么多行的情况下，是否有更好的方法进行计算。
Function SurpAvg(code As String, per As String, var As String, _
dt1 As Range, dt2 As Range)
Dim weight As Variant, fperiod As Variant, ftype As Variant, ann As Variant, surpx As Variant
Dim startdt As Date, enddt As Date
Dim pctL As Double, pctH As Double, surpL As Double, surpH As Double
Dim i As Long, j As Long, a() As Variant, b() As Variant, total As Double, totalWT As Double
ThisWorkbook.Activate
With Application
weight = .Transpose(Range(code).Value)
fperiod = .Transpose(Range("FY").Value)
ftype = .Transpose(Range("FT").Value)
ann = .Transpose(Range("ann").Value)
surpx = .Transpose(Range("surpx").Value)
End With
startdt = dt1.Value
enddt = dt2.Value
pctL = Range("PctL")
pctH = Range("PctH")
surpL = -Range("MaxSurp")
surpH = Range("MaxSurp")
i = -1
On Error GoTo ErrorHandler
For j = LBound(surpx) To UBound(surpx)
If ftype(j) = var And ann(j) > startdt And ann(j) <= enddt And _
IsNumeric(1 / weight(j)) And IsNumeric(1 / surpx(j)) And _
surpx(j) > surpL And surpx(j) < surpH Then
If InStr(fperiod(j), per) Then
i = i + 1
ReDim Preserve a(i) As Variant
ReDim Preserve b(i) As Variant
a(i) = surpx(j)
b(i) = weight(j)
End If
End If
NextJ:
Next j
ErrorHandler:
If Err Then Resume NextJ
surpL = WorksheetFunction.Percentile(a, pctL)
surpH = WorksheetFunction.Percentile(a, pctH)
total = 0: totalWT = 0
For j = LBound(a) To UBound(a)
totalWT = totalWT + b(j)
If a(j) < surpL Then
total = total + surpL * b(j)
ElseIf a(j) > surpH Then
total = total + surpH * b(j)
Else
total = total + a(j) * b(j)
End If
Next j
SurpAvg = total / totalWT
End Function
回答 2
Stack Overflow用户
发布于 2019-09-20 18:02:37
您很可能面临由错误处理导致的无限goto循环，因为过程中唯一的On Error语句在代码底部执行失败时仍然有效。
邦迪解决方案：
ErrorHandler:
If Err.Number <> 0 Then Resume NextJ
On Error GoTo ErrHandler
surpL = WorksheetFunction.Percentile(a, pctL)
surpH = WorksheetFunction.Percentile(a, pctH)
total = 0: totalWT = 0
For j = LBound(a) To UBound(a)
totalWT = totalWT + b(j)
If a(j) < surpL Then
total = total + surpL * b(j)
ElseIf a(j) > surpH Then
total = total + surpH * b(j)
Else
total = total + a(j) * b(j)
End If
Next j
SurpAvg = total / totalWT
ErrHandler:
End Function这很糟糕，因为我们甚至没有费心去找出问题出在哪里，因为它用适当的流控制代替了错误处理。如果存在逻辑错误(例如，我们忽略的错误是一些下标超出范围的错误)，那么这种错误处理会阻止错误浮出水面，并使调试变得比需要的困难得多。
一个真正的解决方案应该首先避免处理错误。例如，通过消除假设：
If totalWT <> 0 Then SurpAvg = total / totalWT当您使用On Error GoTo {label}时，您应该以这样一种方式编写代码:只有在错误状态下才能访问{label}：
Public Sub DoSomething()
On Error GoTo ErrHandler
'...
Exit Sub '<~ end of "happy path"
ErrHandler: '<~ begin "error path"
'...
End SubStack Overflow用户
发布于 2019-09-23 11:03:13
我之所以把它放在这里，是因为评论太长了，虽然我只是在模仿@Mathieu Guindon反复建议的，但如果它能让你走上正确的道路，那么它是值得重复的。
我理解为什么你想要好的错误处理，但你却把注意力集中在错误的方面。如果你不能很好地处理你的错误，你就不可能有好的错误处理。
想一想这对意味着什么
...去掉假设...还有..。使操作以某些特定条件为条件...
以及它如何帮助您
...找出问题所在..。
因为，所以使用
...用适当的流控制代替错误处理...
的主要问题是
...防止bug浮出水面，并使调试变得比需要的困难得多。
我缩小了你的代码范围，只关注一个变量。查看它，看看您是否可以找到在处理程序控制之前没有消除的任何假设，在特定条件下没有完成的任何操作，以及您的代码是否识别或防止了任何错误。
Function SurpAvg([...])
Dim surpx As Variant
[...]
ThisWorkbook.Activate
[...]
surpx = .Transpose(Range("surpx").Value)
[...]
On Error GoTo ErrorHandler
For j = LBound(surpx) To UBound(surpx)
[...]
NextJ:
Next j
ErrorHandler:
If Err Then Resume NextJ
[...]
End Function我看到的唯一被消除的假设是那些被消除为默认处理程序的假设。控制权在没有任何前提条件的情况下交给你的处理程序，甚至工作簿都是用ThisWorkbook.Activate来假定的。假设ActiveWorkbook没有调用外部代码。如果它由外部代码调用(通常使用Personal.xlsb或*.xlam加载项)，则您将使用错误的工作簿；请考虑'Workbook1'Sheet1!A1包含承载在Personal中的自定义项，使用ThisWorkbook表示该函数返回从Personal中的数据派生的值，而不是从'Workbook1'Sheet1!A1中派生的值
仔细看一下：surpx = .Transpose(Range("surpx").Value)这一行是在将控制权分配给错误处理程序之前执行的，所以这里的错误是由缺省处理程序处理的；但是它不能捕获逻辑错误，并且您可能在这里有一个语法正确的错误，但仍然会在代码中进一步导致运行时错误，或者可能导致不准确的结果。例如：
Range("surpx")未显式限定。命名范围surpx的作用域可以是工作簿以及工作簿中任意数量的单个工作表。您的代码假设活动工作表是正确的工作表，并且它会很高兴地接受意外的值，但如果范围不是exist.Range("surpx").Value，那么默认处理程序至少会向您发出错误1004消息的警告。我喜欢div/0错误，所以考虑一下这个范围内的错误会发生什么。surpx是一个Variant，所以在您尝试将其与For j = LBound(surpx) To UBound(surpx)一起使用之前，它很乐意接受"Error 2007“的值，没有任何问题。这是您向处理程序授予权限后的第一行代码，因此默认处理程序无法帮助您，并且不会尝试防止、纠正或提供标识错误的信息。您的处理程序所做的唯一一件事就是默默地跳过一段代码。这是好的错误处理的对立面。
除了已经说过的，我的建议是，重新访问您的数据类型以删除变体，真正地考虑如何调用这段代码，显式地限定您的对象，尽管已经说过了，但值得再重复一遍，在启用自定义处理程序之前，使用默认处理程序来调试程序。
https://stackoverflow.com/questions/58032418
复制
腾讯云开发者
