UDF полностью мертв, когда диапазон имеет 50000 строк для расчета

Question

Я создал UDF ниже, который, как ожидается, будет хорошо работать.Идея состоит в том, чтобы рассчитать средневзвешенное значение для переменной (случаи должны соответствовать критериям).Но когда диапазон содержит 50000 строк (например, 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

Answer 1

Скорее всего, вы сталкиваетесь с бесконечным циклом 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 Sub

Answer 2

Я поместил это здесь, потому что это было слишком долго для комментария, и, хотя Я только попугай, что @Mathieu Guindon неоднократно предлагал , , стоит повторить, если он получитВы на правильном пути.

---

Я понимаю, почему вам нужна хорошая обработка ошибок, но вы зацикливаетесь на неправильном аспекте.Вы не можете иметь хорошую обработку ошибок, если у вас нет хорошей обработки ваших ошибок.

---

Подумайте, что это значит для

[...] исключить допущения [... и ...] сделать операции условными для определенных конкретных условий [...]

и как это вам поможет

[...] выясните, что не так [...]

, потому что

[...] заменяя правильное управление потоком для обработки ошибок [...]

является основной проблемой

[...] предотвращает появление ошибки и делает отладку намного сложнее, чем нужно.

---

Я сузил ваш код, чтобы сосредоточиться на одной переменной.Посмотрите на это и посмотрите, сможете ли вы найти какие-либо предположения, которые не были устранены до того, как ваш обработчик получил контроль, какие-либо операции, которые не выполняются при определенных условиях, и если ваш код идентифицирует или предотвращает что-либо, что является неправильным.

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», «Лист1! A1» содержит UDF, размещенный в «Личном», с использованием ThisWorkbook означает, что функция возвращает значение, полученное из данных в «Личном кабинете», а не из данных в «Рабочей тетради 1»!at: surpx = .Transpose(Range("surpx").Value) Эта строка выполняется до того, как управление назначено вашему обработчику ошибок, поэтому ошибка здесь обрабатывается обработчиком по умолчанию;но он не может перехватить логические ошибки, и здесь может быть синтаксически правильная ошибка, которая все же вызывает дальнейшую ошибку во время выполнения кода или, возможно, приводит к неточному результату.Например:

• Range("surpx") явно не указано.Именованный диапазон surpx можно охватить рабочую книгу и любое количество отдельных рабочих листов внутри нее.Ваш код предполагает, что активный лист является правильным листом, и он с радостью примет неожиданные значения, но по крайней мере обработчик по умолчанию предупредит вас сообщением об ошибке 1004, если диапазон не существует.
• Range("surpx").Value принимается вслепуюи используется без предварительных условий.Мне нравятся div/0 ошибок, поэтому рассмотрим, что происходит с одним в этом диапазоне.surpx - это Variant, поэтому он без проблем принимает значение «Ошибка 2007», пока не попробуете использовать его с For j = LBound(surpx) To UBound(surpx).Это первая строка кода после того, как вы дали полномочия своему обработчику, поэтому обработчик по умолчанию не может вам помочь, и буквально нет попыток предотвратить, исправить или предоставить информацию, которая идентифицирует ошибку.Единственное, что делает ваш обработчик - молча пропускает блок кода.Это противоположность хорошей обработке ошибок.

Мой совет, помимо того, что уже было сказано, еще раз проверьте ваши типы данных, чтобы удалить варианты, действительно подумайте о том, как этот код вызывается, явно квалифицируйте ваши объектыи, хотя это было сказано, стоит повторить еще раз, используйте обработчик по умолчанию для отладки программы перед включением пользовательского обработчика .