使用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

下面是一个使用 Scott 建议的示例方法。 在我的电脑上，这在几分之一秒内运行。

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