Question

需要帮助每隔5秒从= RTD Microsoft Excel功能保存历史数据。我正在使用Application.Wait（Now + TimeValue（“00:00:05”））并逐行将数据复制到另一张表。

问题是在等待间隔期间不允许= RTD刷新数据，并且相同的数据不断被复制到宏启动时单元格中的行。

附加细胞的代码和图像＆amp;历史数据。

我的代码：

Sub Macro_CreateHistoricalData()

For i = 1 To 50
Sheets("Sheet1a").Select

Range("Q1").Select
Application.CutCopyMode = False
Selection.ClearContents

ActiveCell.FormulaR1C1 = "=NOW()"

Range("Q1:Q4").Select
Selection.Copy

Sheets("Sheet2").Select
Range("A1").Select

'Paste special with transpose to other sheet

ActiveCell.Offset(i, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=True

Next i

Sheets("Sheet1a").Select
Range("Q1").Select
Application.CutCopyMode = False

End Sub

Data to be picked up from first sheet

Output that I am getting

*******请忽略两张图片的时差，这是由于在不同时间拍摄的截图，理想情况下，最后一行的时间应该与第一张图片中的时间相匹配。

感谢。

Answer 1

Application.Wait在您设置的时间内冻结（停止）您的应用程序（Excel）。

尝试使用这样的计时器：

Option Explicit
Dim TimerVal As Integer, TimerCount As Integer

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Sub TimerStart(newTimer As Boolean)
  If newTimer Then
    TimerVal = SetTimer(0, 0, 5000, AddressOf TimerTic) '5000 = time in ms >> 5000ms = 5s
    TimerCount = 0
  Else
    KillTimer 0, TimerVal
  End If
End Sub

Sub TimerTic(ByVal a As Long, ByVal b As Long, ByVal TimerCode As Long, ByVal c As Long)      
  If TimerCode = TimerVal And TimerCount < 50 Then 'If Timer is known and tics are left
    Macro_CreateHistoricalData 'Call your macro without Loops
  Else
    KillTimer 0, TimerCode 'Kill the timer so it wont run forever
  End If
End Sub

Sub Macro_CreateHistoricalData()
  TimerCount = TimerCount + 1
  Application.CutCopyMode = False
  Sheets("Sheet1a").Range("Q1").ClearContents
  Sheets("Sheet1a").Range("Q1").FormulaR1C1 = "=NOW()"
  Sheets("Sheet1a").Range("Q1:Q4").Copy
  Sheets("Sheet2").Range("A1").Offset(TimerCount, 0).PasteSpecial xlPasteValues, xlNone, False, True
  Application.CutCopyMode = False
End Sub

使用TimerStart True或Call TimerStart(True)

启动此宏定时器

编辑：我用这个宏玩了一下，发现了1个问题:(
当你将文本插入单元格或类似的东西时触发tic-macro时，excel可能会崩溃：（

所以如果有可能出现此问题，我会将其更改为lilbit

Option Explicit
Dim TimerVal As Variant, TimerCount As Integer

Sub TimerStart()
  TimerCount = 0
  TimerVal = Now + TimeValue("00:00:01")
  Application.OnTime TimerVal, "Macro_CreateHistoricalData", , True
  'only execute the macro if excel is "ready" to do it
End Sub

Sub Macro_CreateHistoricalData()
  If IsEmpty(TimerVal) Then Exit Sub

  Application.CutCopyMode = False
  Sheets("Sheet1a").Range("Q1").ClearContents
  Sheets("Sheet1a").Range("Q1").FormulaR1C1 = "=NOW()"
  Sheets("Sheet1a").Range("Q1:Q4").Copy
  Sheets("Sheet2").Range("A1").Offset(TimerCount, 0).PasteSpecial xlPasteValues, xlNone, False, True
  Application.CutCopyMode = False

  TimerVal = Now + TimeValue("00:00:05")
  TimerCount = TimerCount + 1
  If TimerCount < 50 Then Application.OnTime TimerVal, "Macro_CreateHistoricalData", , True
End Sub

注意：一开始不使用TimerCount = 0，将保留旧值。即50个计数后它会自动停止，TimerCount仍然是50.开始下一个循环不会工作，直到你重置宏;）

从Microsoft Excel RTD功能创建历史数据

1 个答案: