Лучший способ активировать между двумя книгами в приложении.OnTime loop VBA

#vba #excel #macros

#vba #excel #макросы

Вопрос:

У меня есть workbook1 который подключен к API данных. Я хочу делать снимок значений ячеек каждые 5 секунд из workbook1 и объединять его с набором данных в workbook2 следующей пустой строке.

Однако я думаю, что мой код неправильно переключается между двумя книгами. В качестве примера я ввел несколько жестких чисел в workbook1 и запустил макрос. Код копирует и вставляет твердые числа из workbook1 в workbook2 , как и ожидалось. Однако, как только я вручную изменил числа в workbook1 , макросу не удается зафиксировать изменения в последующих объединенных строках в workbook2 .

Кто-нибудь может помочь?

 Sub timer() 

If Hour(Time) <= 16 Then

Application.OnTime Now()   TimeValue("00:00:05"), "dataextract"

ElseIf Hour(Time) >= 18 Then

Application.OnTime Now()   TimeValue("00:00:05"), "dataextract"

End If

End Sub

Sub dataextract()

Dim Datetime As Date
Dim Bid As Single
Dim Ask As Single
Dim BidVol As Integer
Dim AskVol As Integer
Dim dataset As Workbook 

Worksheets("Sheet1").Select
Datetime = Range("B2")
Bid = Range("C2")
Ask = Range("D2")
BidVol = Range("E2")
AskVol = Range("F2")

Set dataset = Workbooks.Open("C:UsersaliDesktopDataset.xlsx") 'dataset is workbook2
Worksheets("Sheet1").Select
Worksheets("Sheet1").Range("B1").Select
RowCount = Worksheets("Sheet1").Range("B1").CurrentRegion.Rows.Count
With Worksheets("Sheet1").Range("B1")
.Offset(RowCount, 0) = Datetime
.Offset(RowCount, 1) = Bid
.Offset(RowCount, 2) = Ask
.Offset(RowCount, 3) = BidVol
.Offset(RowCount, 4) = AskVol
End With

dataset.Save

timer

End Sub
  

Ответ №1:

Вам следует проверить, открыта ли еще внешняя книга.

 Sub timer()

    If Hour(Time) <= 16 Or Hour(Time) >= 18 Then

        Application.OnTime Now()   TimeValue("00:00:05"), "dataextract"

    End If

End Sub

Sub dataextract()
    Dim dataset As Workbook
    On Error Resume Next

    Set dataset = Workbooks("Dataset.xlsx")
    If dataset Is Nothing Then Set dataset = Workbooks.Open("C:UsersaliDesktopDataset.xlsx")

    On Error GoTo 0

    With dataset.Worksheets("Sheet1")
        With .Range("B" amp; .Rows.count).End(xlUp).Offset(1)

            .Resize(1, 5).Value = ThisWorkbook.Worksheets("Sheet1").Range("B2:F2")

        End With
    End With

    dataset.Save

    timer

End Sub
  

Комментарии:

1. Я получаю сообщение об ошибке: «Объект не поддерживает это свойство или метод» на .Resize(1, 5).Values = ThisWorkbook.Worksheets("Sheet1").Range("B2:F2") . Может быть, я использую Excel 2013?

2. Я обновил свой ответ. Должно быть .Значение not . Значения

3. Код выполняется сейчас, но он ничего не вставляет в dataset.xlsx … Я имею в виду, я понимаю, что эта строка принимает диапазон B2: F2 и вставляет его в следующую пустую строку в dataset.xlsx … почему он вставляет пустой?