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

时间:2016-02-05 23:08:43

标签: excel vba excel-vba

问题: 我已经广泛搜索了这个并且似乎无法让它工作。当按下“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

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

1 个答案:

答案 0 :(得分:0)

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

<强> 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的操作是直接值传输¹,没有.GoToActiveCellSelect

我不清楚你在尝试用价值转移做什么。我在Sheet1上一个接一个地堆叠它们。

time_cycle_pricing

您可以在所有代码表的顶部添加Option Explicit²。这需要变量声明,如果你错放了一个公共变量,你很快就会知道。

¹有关远离依赖选择和激活以实现目标的更多方法,请参阅How to avoid using Select in Excel VBA macros

²在VBE的工具►选项►编辑器属性页面中设置需要变量声明 Option Explicit 语句放在每个新的顶部创建代码表。这将避免像拼写错误这样的错误编码错误以及影响您在变量声明中使用正确的变量类型。在没有声明的情况下即时创建的变量都是变体/对象类型。使用选项明确被广泛认为是“最佳做法”。