Excel, обновить данные RTD из VBA Macro
Я пытаюсь вывести данные RTD из торгового приложения Interactive Brokers в Excel, используя ссылки RTD. Я торгую опционами, и цель состоит в том, чтобы составить список страйков для продукта, которым я еще не торговал. Я хочу ввести данные, и если они соответствуют определенным критериям, либо сохраните их, либо переходите к следующему удару.
Проблема в том, что данные в ячейках не обновляются во время работы макроса. У меня есть код ниже. Все, что я прокомментировал, это то, что я пробовал. Сейчас я работаю с отключенным автоматическим вычислением и пытаюсь принудительно вычислить лист в макросе. Если я вступлю в макрос, он работает; клетки обновляются, и я могу двигаться дальше. Хотя, очевидно, я не хочу, чтобы F8 прошел несколько тысяч ударов.
Sub BuildStrikes()
'Application.RTD.ThrottleInterval = 1
Dim row, SelRows, Column, Test As Integer
Dim Strike As Double
Dim stock As String
row = 2
SelRows = 4
Test = 0
Strike = 40
Column = 4
'Application.ScreenUpdating = False
Do While Not IsEmpty(Sheets("StartList").Cells(row, 1))
stock = Sheets("StartList").Cells(row, 1)
Sheets(stock).Select
Do While SelRows < 251
Test = 0
Column = 4
Do While Test < 4
Cells(SelRows, 1) = Strike
Range("D" & SelRows & ":G" & SelRows).Select
Selection.Replace What:="foo", Replacement:="tws", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Application.RTD.RefreshData
'Application.Calculation = xlCalculationManual
'Application.Calculation = xlCalculationAutomatic
Application.Calculate
'If Not Application.CalculationState = xlDone Then
' DoEvents
' End If
'Range("A5000:B5000").Select
''Selection.ClearContents
'Cells(SelRows, 1).Select
Application.RTD.RefreshData
'WasteTime (1)
'Call UpdateLinks
'ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources, Type:=xlExcelLinks
'ActiveWorkbook.UpdateLink Name:=ActiveWorkbook.LinkSources, Type:=xlOLELinks
Application.CalculateFull
For Column = 4 To 7
If IsNumeric(Cells(SelRows, Column)) Then
If Cells(SelRows, Column) = 0 Then
Test = Test
Else
Test = Test + 1
End If
End If
Next Column
If Test < 4 Then
Strike = Strike + 0.5
Test = 0
If Strike > 80 Then
SelRows = 252
Test = 4
row = row + 1
End If
Else
Test = 4
SelRows = SelRows + 1
Strike = Strike + 0.5
If Cells(SelRows - 1, 4) = -1 Then
SelRows = 252
row = row + 1
End If
If Strike > 80 Then
SelRows = 252
row = row + 1
End If
End If
Loop
Loop
Loop
'Application.RTD.ThrottleInterval = 2000
'Application.ScreenUpdating = True
End Sub