如何使用用户窗体按钮控件将时间戳链接到单元格?

时间:2012-06-04 22:21:51

标签: vba excel-vba timer stopwatch excel

你好VB开发人员/用户/爱好者。你好吗?

我有一个Userform,它有两个按钮:

  1. 开始
  2. 停止
  3. 当我按Start时,我希望以特定列中的dd/mm/yy hh:nn:ss格式记录当前时间。

    然后当我按下Stop按钮时,我希望它再次在它旁边的单元格中记录时间。

    然后,如果我再次按Start,我希望它记录在第一个单元格的当前记录下方。基本上我正在构建一个计时器来记录数据以查看某些任务需要多长时间。

    我会发布excel文件,并在必要时提供更多信息。

    感谢您提供的任何帮助。

    当前代码

    Public runTimer As Double
    Public startTime As Date
    Dim counter As Date
    
    Sub setStart()
        counter = 0
        startTime = Now
        runTimer = Now + TimeSerial(0, 0, 1)
    
        Application.OnTime runTimer, "setStart", , True
    
        Set myTime = Sheet4.Range("F1")
        Set timeRng = Sheet4.Range("C8:C100")
        i = WorksheetFunction.CountA(timeRng)
        i = i + 1
    
        Cells(i, "C") = myTime
        Sheet4.Cells(i, "C").NumberFormat = "yyyy/mm/dd HH:mm:ss"
    
        If i >= 2 Then
            Cells(i, "D8") = Cells(i, "C8") - Cells(i - 1, "C8")
            Sheet4.Cells(i, "C").NumberFormat = "yyyy/mm/dd HH:mm:ss"
        End If
        Application.EnableEvents = False
    End Sub
    
    Sub setStop()
        Application.OnTime runTimer, "setStop", , True
    
        Set myTime = Sheet4.Range("F1")
        Set timeRng = Sheet4.Range("D8:D100")
        i = WorksheetFunction.CountA(timeRng)
        i = i + 1
    
        Application.EnableEvents = False
        Cells(i, "D") = myTime
        Sheet4.Cells(i, "D").NumberFormat = "yyyy/mm/dd HH:mm:ss"
    End Sub
    

    感谢您的反馈和建议。

    这两项工作都很棒。我仍然遇到在代码中的特定工作表中记录数据的问题。我不想使用当前的工作表。我希望它是sheet1并在单元格“A8”中开始录制而不是单元格“A2”

    感谢。

2 个答案:

答案 0 :(得分:1)

我已经做了类似的事情来跟踪从Excel应用程序运行时SQL和MDX查询需要多长时间。用户对某事花了多长时间的感觉(花了5分钟!)和实际发生的事情并不总是一致的。我需要知道某些事情需要多长时间来保护应用程序或理解我需要优化的内容。

我设置了一张模板来模仿你的例子。第1行中的标题:

Start Time     Stop Time     Elapsed Time

我还有一个开始按钮和一个停止按钮。我将setStart分配给了开始按钮,setStop分配给了停止按钮。

代码:

Option Explicit

Sub setStart()
    Dim NextRow As Long
    NextRow = GetLastRow("A") + 1

    With Range("a" & NextRow)
        .Value = Now
        .NumberFormat = "yyyy/mm/dd HH:mm:ss"
    End With
End Sub

Sub setStop()
    Dim NextRow As Long
    NextRow = GetLastRow("B") + 1

    With Range("b" & NextRow)
        .Value = Now
        .NumberFormat = "yyyy/mm/dd HH:mm:ss"
    End With
    calcElapsedTime (NextRow)
End Sub

Sub calcElapsedTime(NextRow As Long)
    With Range("c" & NextRow)
        .Formula = "=B" & NextRow & "-A" & NextRow
        .NumberFormat = "HH:mm:ss"
    End With
End Sub

Function GetLastRow(ColumnLetter As String) As Long
    GetLastRow = Range(ColumnLetter & ActiveSheet.Rows.Count).End(xlUp).Row
End Function

请注意,我没有检查启动和停止是否以正确的顺序完成。如果按下启动3次,它将继续在起始列中添加没有匹配停止时间的值,这显然会消耗经过的时间。如果我提供的代码是您所追求的,那么您需要将这种逻辑添加到您的应用中。

答案 1 :(得分:0)

我喜欢餐饮业@Head的简单回答。您可以稍微将其更改为单个按钮,以便您只能根据需要进行启动或停止。

您可以为按钮文本和视觉提醒设置颜色格式。

只需添加几个并在CommandButton1上运行startTimer

    Option Explicit
Sub startTimer()
If ActiveSheet.CommandButton1.Caption = "START" Then
        setStart
    Else
        setStop
    End If
End Sub
Sub setStart()
    Dim NextRow As Long
    NextRow = GetLastRow("A") + 1

    With Range("a" & NextRow)
        .Value = Now
        .NumberFormat = "yyyy/mm/dd HH:mm:ss"
    End With
   ActiveSheet.CommandButton1.Caption = "STOP"
End Sub

Sub setStop()
    Dim NextRow As Long
    NextRow = GetLastRow("B") + 1

    With Range("b" & NextRow)
        .Value = Now
        .NumberFormat = "yyyy/mm/dd HH:mm:ss"
    End With
    calcElapsedTime (NextRow)
    ActiveSheet.CommandButton1.Caption = "START"
End Sub

Sub calcElapsedTime(NextRow As Long)
    With Range("c" & NextRow)
        .Formula = "=B" & NextRow & "-A" & NextRow
        .NumberFormat = "HH:mm:ss"
    End With
End Sub

Function GetLastRow(ColumnLetter As String) As Long
    GetLastRow = Range(ColumnLetter & ActiveSheet.Rows.Count).End(xlUp).Row
End Function