Question

我有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:\Users\ali\Desktop\Dataset.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

Answer 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:\Users\ali\Desktop\Dataset.xlsx")

    On Error GoTo 0

    With dataset.Worksheets("Sheet1")
        With .Range("B" & .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

在Application.OnTime循环VBA中激活2个工作簿之间的最佳方法

1 个答案: