每 5 秒在另一个工作表 VBA 中记录 2 个单元格中的值

Question

问题： 我已经对此进行了广泛的搜索，但似乎无法使其正常工作。当按下“StartBtn”时，我有一个计时器正在运行：

Dim StopTimer           As Boolean
Dim SchdTime            As Date
Dim Etime               As Date
Dim currentcost         As Integer
Const OneSec            As Date = 1 / 86400#

Private Sub ResetBtn_Click()
    StopTimer = True
    Etime = 0
    [TextBox21].Value = "00:00:00"
End Sub

Private Sub StartBtn_Click()
   StopTimer = False
   SchdTime = Now()
   [TextBox21].Value = Format(Etime, "hh:mm:ss")
   Application.OnTime SchdTime + OneSec, "Sheet1.NextTick"
End Sub

Private Sub StopBtn_Click()
    StopTimer = True
    Beep
End Sub

Sub NextTick()
   If StopTimer Then
      'Don't reschedule update
   Else
      [TextBox21].Value = Format(Etime, "hh:mm:ss")
      SchdTime = SchdTime + OneSec
      Application.OnTime SchdTime, "Sheet1.NextTick"
      Etime = Etime + OneSec
   End If
End Sub

然后在另一个单元格（例如 C16）中，我有一个手动输入的值，即每小时成本费率。我有第三个单元格，它通过 C16*当前计时器值计算总成本。

我想要做的是在单击“StartBtn”后每 5 秒记录一次当前时间和当前计算的成本在另一张表中。这是我开始的：

Sub increment()
Dim x As String
Dim n As Integer
Dim Recordnext As Date

n = 0
Record = [TextBox21].Value
Recordnext = [TextBox21].Value + OneSec

Range("B13").Value = Recordnext

Do Until IsEmpty(B4)
    If [TextBox21].Value = Recordnext Then ActiveCell.Copy
      Application.Goto(ActiveWorkbook.Sheets("Sheet2").Range("A1").Offset(1, 0))
        ActiveSheet.Paste
        Application.CutCopyMode = False
        n = n + 1
        Recordnext = [TextBox21].Value + 5 * (OneSec)
    Exit Do
    End If
    ActiveCell.Offset(1, 0).Select
Loop
End Sub

但它不起作用。任何帮助将不胜感激。

Answer 1

我已尝试将您的计时器方法简化为实际需要的方法。

Sheet1 code sheet

Option Explicit

Private Sub ResetBtn_Click()
    bRun_Timer = False
    'use the following if you want to remove the last time cycle
    TextBox21.Value = Format(0, "hh:mm:ss")
End Sub

Private Sub StartBtn_Click()
    bRun_Timer = True
    dTime_Start = Now
    TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
    Range("D16").ClearContents
    Call next_Increment
End Sub

Module1 code sheet

Option Explicit

Public bRun_Timer As Boolean
Public Const iSecs As Integer = 3  'three seconds
Public dTime_Start As Date

Sub next_Increment()
    With Worksheets("Sheet1")
        .TextBox21.Value = Format(Now - dTime_Start, "hh:mm:ss")
        .Range("D16") = Sheet1.Range("C16") / 3600 * _
                              Second(TimeValue(Sheet1.TextBox21.Value)) '# of secs × rate/sec
        Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Resize(1, 2).Offset(1, 0) = _
            Array(.TextBox21.Value, .Range("D16").Value)
    End With

    If bRun_Timer Then _
        Application.OnTime Now + TimeSerial(0, 0, iSecs), "next_Increment"
End Sub

请注意，将数据传输到 Sheet2 的操作是直接值传输¹，没有 .GoTo、ActiveCell 或 Select。

我并不完全清楚你试图对价值转移做什么。我在Sheet1上一个接一个地堆叠起来。

        

将Option Explicit² 添加到所有代码表的顶部会受益匪浅。这需要变量声明，如果您放错了公共变量，您很快就会知道。

---

¹ _{请参阅How to avoid using Select in Excel VBA macros，了解更多摆脱依赖选择和激活来实现目标的方法。}

² _{在 VBE 的工具 ► 选项 ► 编辑器属性页面中设置 需要变量声明 会将 Option Explicit 语句放在每个新创建的代码的顶部床单。这将避免愚蠢的编码错误，如拼写错误，并影响您在变量声明中使用正确的变量类型。动态创建的没有声明的变量都是变体/对象类型。使用 Option Explicit 被广泛认为是“最佳实践”。}