#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
… почему он вставляет пустой?