Использование VBA для размещения чисел в соответствии с заданными интервалами, как ускорить программу?

Question

У меня есть столбец чисел и 11 интервалов. Я хотел поместить каждое число в интервал, которому оно принадлежит, а также определить, близко ли число к верхней или нижней границе.

Например: если первое число равно 210, и оно должно быть в моем интервале от 180 до 365, и оно близко к 180, то верните «Нижняя граница».

Вот мой код, однако он работал слишком медленно! У меня всего 5197 номеров, но на его запуск уходит около 202 секунд, более 3 минут! Я хочу обратиться к вам за помощью: где моя программа неэффективна и как повысить эффективность?

Если у меня еще больше чисел или больше критериев для добавления, программа должна быть еще медленнее: (

Большое спасибо !!

Sub test()

bgn = Timer

Application.ScreenUpdating = False

Dim T(1 To 12) As Integer 'My intervals
T(1) = 1 
T(2) = 7
T(3) = 14
T(4) = 30
T(5) = 60
T(6) = 90
T(7) = 180
T(8) = 365
T(9) = 730 
T(10) = 1095 
T(11) = 1460 
T(12) = 1825 

For p = 4 To 5200 'My first number starts at row 4, so total 5197 numbers up to row 5200
     For q = 1 To 11

        'My column of numbers are in column G
        If Range("G" & p) > T(q) And Range("G" & p) <= T(q + 1) Then

            Range("H" & p) = T(q) 'Lower bound number
            Range("I" & p) = T(q + 1) 'Upper bound number

            'Determine closer to upper bound or lower bound                
            If Abs(Range("G" & p) - T(q)) >= Abs(Range("G" & p) - T(q + 1)) Then
                Range("J" & p) = "Upper Bound"                
            Else
                Range("J" & p) = "Lower Bound"
            End If
            Exit For
        End If
    Next q
Next p

MsgBox Timer - bgn

End Sub

Answer 1

Вот пример подхода, использующего предложение Скотта.На моем ПК это выполняется за доли секунды.

Sub test()

    Dim bgn, p, q, arrIn, arrOut(), v
    Dim rngInput As Range

    bgn = Timer

    Application.ScreenUpdating = False

    Dim T(1 To 12) As Integer 'My intervals
    T(1) = 1
    T(2) = 7
    T(3) = 14
    T(4) = 30
    T(5) = 60
    T(6) = 90
    T(7) = 180
    T(8) = 365
    T(9) = 730
    T(10) = 1095
    T(11) = 1460
    T(12) = 1825

    Set rngInput = Range("G4:G5200")

    arrIn = rngInput.Value                       'get all inputs in an array
    ReDim arrOut(1 To UBound(arrIn, 1), 1 To 3)  'size an array to take the outputs

    For p = 1 To UBound(arrIn, 1) 'My first number starts at row 4, so total 5197 numbers up to row 5200
         v = arrIn(p, 1)
         For q = 1 To 11
            If v > T(q) And v <= T(q + 1) Then
                'populate the output array
                arrOut(p, 1) = T(q) 'Lower bound number
                arrOut(p, 2) = T(q + 1) 'Upper bound number
                arrOut(p, 3) = IIf(Abs(v - T(q)) >= Abs(v - T(q + 1)), "Upper Bound", "Lower bound")
                Exit For
            End If
        Next q
    Next p

    rngInput.Offset(0, 1).Resize(, 3).Value = arrOut '<< place the outputs on the sheet

    Debug.Print Timer - bgn

End Sub