计时器或代码不符合时间表

我有代码，我正在访问实时货币数据的XML饲料。 我需要每隔3分钟收集一次价格，这个价格必须相当准确，否则会抛出其他计算。

我设置了一个计时器，每3分钟运行一次代码，或者select任何时间间隔。

我开始注意到滑动，刚开始是一两秒，但已经变成了十秒钟。 有什么想法吗？

Sub xmlData() Dim aSwitch As String: aSwitch = Sheet2.[Switch].Value Dim aSymbol As String: aSymbol = Sheet2.[Symbol].Value 'check [switch] status If aSwitch = "OFF" Then MsgBox "Switch is OFF!", vbCritical, "Program Status" Exit Sub End If 'MsgBox "Program is ON!", vbCritical, "Program Status" 'refresh xml data Dim iMap As XmlMap Set iMap = ActiveWorkbook.XmlMaps(1) iMap.DataBinding.LoadSettings "http://****.com/webservice/v1/symbols/" & aSymbol & "/quote" iMap.DataBinding.Refresh 'dim inputs Dim aStart As String: aStart = Sheet2.Range("c3").Text Dim aInterval As String: aInterval = Sheet2.Range("d3").Text Dim aStatus As String: aStatus = Sheet2.[Status].Value 'oth Dim aSecurity As String: aSecurity = Sheet2.[Security].Value Dim aPrice As String: aPrice = Sheet2.[Price].Value Dim aDatetime As String: aDatetime = Sheet2.[DateTime].Value 'separate adatetime Dim aDate As String: aDate = Mid(aDatetime, 1, 10) Dim aTime As String: aTime = Mid(aDatetime, 12, 10) 'Time actual Dim aTimeNow As String: aTimeNow = Format(Now(), "HH:mm:ss") 'copy xml data to table Dim aRow As Long aRow = Sheet2.Cells.Find(What:="*", SearchOrder:=xlRows, _ SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1 Sheet2.Cells(aRow, 1).Value = aDate Sheet2.Cells(aRow, 2).Value = aTime Sheet2.Cells(aRow, 3).Value = aSecurity Sheet2.Cells(aRow, 4).Value = aPrice Sheet2.Cells(aRow, 5).Value = aTimeNow 'start timer for reload Application.OnTime Now + TimeValue(aInterval), "xmlData" End Sub 

编辑160627

XML有没有可能马上获取？

Answer 1

按绝对值计算预定时间，而不是从Now的差值。 （现在总是在最后一次预定时间之后的一段时间，所以总是会慢慢地）

 Sub xmlData() Static ScheduleTime As Variant ' Statis retains value between executions Dim aInterval As String ' other code ' ... If ScheduleTime = 0 Then ' initialise on first execution ScheduleTime = Now + TimeValue(aInterval) Else ' schedule based on last scheduled time ' this assumes execution time is always less than interval ScheduleTime = ScheduleTime + TimeValue(aInterval) End If Application.OnTime Now + TimeValue(aInterval), "xmlData" End Sub