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

以下是该代码中发现的问题

函数中的相同循环用于两次，以获取startRowNum和endRowNum从而倍增时间
一旦找到startRowNum和endRowNum，函数循环中就没有退出点。它正在完成循环直到结束
似乎并非所有目的都需要VBA。可以使用excel公式轻松完成。
如果出于任何原因要执行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

优化VBA功能循环

1 个答案: