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

0 ответов

Другие вопросы по тегам