Question

我正在尝试创建一个Excel工具，以帮助衡量我们的销售代表与客户互动，通话或进行理赔研究的时间。我有一个功能正常的秒表，每次你开始时累积时间。但是，我希望每次关闭应用程序时，将当前日期的累计时间填充到日历中。例如，代表在9月1日总共有1:14:29的客户互动。当她关闭Excel时，我希望将时间数据放入代表9月1日的单元格中。有任何想法吗？我已经包含了秒表的代码。

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

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

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

Sub StopBtn_Click()
    StopTimer = True
    Beep
End Sub

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

Answer 1

You haven't specified how you are storing the total elapsed time. I've created an example below, but please change it to suit your needs.

The key to solving your problem is in using the Workbook_BeforeClose event in the ThisWorkbook object. (Using the Workbook_Open event helps too, as you see below in my example.)

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim todaysDate As Date
    Dim todaysRange As Range
    Dim dateRange As Range
    Dim ws As Worksheet
    Dim lastRow As Long

    Set ws = ActiveSheet

    If Not StopTimer Then
        '--- turn off the timer if it's still running
        StopTimer = True
    End If

    todaysDate = Date

    '--- you'll have declare how and where you're storing the
    '    "hours on date" information. the example here is that
    '    you have a list of dates in column D. If you find the
    '    date then add the current timer value to it, if you
    '    don't find the date then create a new line for the
    '    date and hours
    Set dateRange = ws.Range("D:D")
    Set todaysRange = dateRange.Find(What:=todaysDate, _
                                     After:=dateRange.Cells(1, 1), _
                                     LookAt:=xlWhole, _
                                     SearchDirection:=xlNext, _
                                     SearchFormat:=False)
    If todaysRange Is Nothing Then
        '--- not found, create a new row at the end
        lastRow = ws.Cells(ws.Rows.Count, 4).End(xlUp).Offset(Abs( _
                           ws.Cells(ws.Rows.Count, 4).End(xlUp).Value <> ""), 0).Row
        Set todaysRange = dateRange.Cells(lastRow, 1)
        todaysRange.Offset(0, 0).Value = todaysDate
        todaysRange.Offset(0, 1).Value = 0
    End If
    todaysRange.Offset(0, 1).Value = todaysRange.Offset(0, 1).Value + _
                                     ws.Range("B3").Value
End Sub

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    '--- resets the timer value each time you open the
    '    workbook, so it appropriately starts from zero
    ws.Range("B3").Value = 0
End Sub

将Excel中累积的时间数据自动填充到日历中

1 个答案: