优化VBA功能循环

Question

我需要优化一些目前可以正常工作的VBA。

给定连续日期（列B）和时间（列C）的列，以及给定时间窗口（T1和T2），返回日期和时间在T1和T2内的行范围。 例如，我希望两者之间的最低价和最高价。

目标是为Excel烛台图构建打开/高/低/收盘图，数据源具有超过260,000行数据。

我目前有以下代码

Dim priceRange As Range
startRowNum = GetFirstRow(StartTime)     << THIS TAKE 10 SECONDS
endRowNum = GetLastRow(endTime)         << THIS TAKE 10 SECONDS
Set priceRange = Range(Cells(startRowNum, 4), Cells(endRowNum, 4))
targetRange.Offset(0, 2).Value = Application.WorksheetFunction.Max(priceRange) 
targetRange.Offset(0, 3).Value = Application.WorksheetFunction.Min(priceRange) 

要找到第一行...

Function GetFirstRow(T As Date) As Long

'Starts at FirstRow and returns the first row where the time is greater than T1.

Dim currentRow As Long
Dim CompareTime As Date
Dim CompareDate As Date

currentRow = 4 'Start at row4 due to headers.

Do While (IsDate(Cells(currentRow, 2)))
    CompareDate = Cells(currentRow, 2)
    CompareTime = Cells(currentRow, 3)
    marketTime = CompareDate + CompareTime
  If (marketTime >= T) Then Exit Do
  currentRow = currentRow + 1
Loop

GetFirstRow = currentRow

End Function

GetLastRow非常相似。

我的问题是，GetFirstRow函数必须处理49,000（是，四万九千）行，大约需要10秒钟。 ...因此需要“分钟”来完成此运行。

有人可以帮我优化吗？

注意由于市场数据从前一天晚上开始，所以我需要日期。 如果这让我放慢了速度，可以在导入数据时对其进行过滤吗？

Answer 1

以下是代码中观察到的问题

1. 该函数中的同一循环两次用于获取startRowNum和endRowNum因此时间加倍
2. 一旦找到startRowNum和endRowNum ，函数循环中就没有退出点。 它正在完成循环直到结束
3. 似乎并非所有目的都需要VBA。 使用excel公式可以轻松完成。
4. 如果出于任何原因要执行VBA循环，则单个循环应提取该单个循环中的所有必需参数（可能是多个库存）。 可以修改下面的测试代码以适应现有代码，因为没有使用函数来避免重复使用，从而降低了性能。 该代码使用260 K行接近底部数据进行了测试，仅花费0.5秒即可计算所有四个参数。

代码使用数组

Option Explicit
Sub test()
Dim T1 As Date, T2 As Date
T1 = #8/12/2019 9:30:00 AM#
T2 = #8/12/2019 3:30:00 PM#

Dim PriceRange As Range, LastRow As Long
Dim MarketTime As Date
Dim Arr As Variant
Dim Rw As Long, StRow As Long
Dim tm As Double

Dim SRow As Long
Dim Erow As Long
Dim MaxPrice As Double
Dim MinPrice As Double

tm = Timer
With ThisWorkbook.ActiveSheet
StRow = 4
LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
Set PriceRange = .Range(.Cells(StRow, 2), .Cells(LastRow, 4))
Arr = PriceRange.Value
SRow = 0
Erow = 0
MaxPrice = -999999999
MinPrice = 999999999


Rw = 1
    Do While Rw <= UBound(Arr, 1)
    If IsDate(Arr(Rw, 1)) Then
    MarketTime = Arr(Rw, 1) + Arr(Rw, 2)
        If (MarketTime >= T1) And SRow = 0 Then SRow = Rw

        'If Rw Mod 1000 = 0 Then Debug.Print Rw, MarketTime, T1

        If SRow > 0 And Arr(Rw, 3) > MaxPrice Then
        MaxPrice = Arr(Rw, 3)
        End If

        If SRow > 0 And Arr(Rw, 3) < MinPrice Then
        MinPrice = Arr(Rw, 3)
        End If

        If (MarketTime >= T2) Then
        Erow = Rw
        Exit Do
        End If

    End If
    Rw = Rw + 1
    Loop
End With

Debug.Print SRow, Erow, MaxPrice, MinPrice
Debug.Print "Seconds taken " & Timer - tm
End Sub