Question

以下代码由Dick Kusleika在（Countdown Timer Excel VBA - Code crashed excel）中作为答案提供，并且有用且有效。但有没有办法改进上面的Excel VBA代码，以便倒计时将继续工作，尽管在单元格中进行任何输入？

Sub NewTimer()

    Dim Start As Single
    Dim Cell As Range
    Dim CountDown As Date

    'Timer is the number of seconds since midnight.
    'Store timer at this point in a variable
    Start = Timer

    'Store A1 in a variable to make it easier to refer
    'to it later. Also, if the cell changes, you only
    'have to change it in one place
    Set Cell = Sheet1.Range("A1")

    'This is the starting value. Timeserial is a good
    'way to get a time
    CountDown = TimeSerial(0, 0, 30)

    'Set our cell to the starting value
    Cell.Value = CountDown

    'Keep executing this loop until A1 hits zero or
    'even falls slightly below zero
    Do While Cell.Value > 0
        'Update the cell. Timer - Start is the number of seconds
        'that have elapsed since we set Start.
        Cell.Value = CountDown - TimeSerial(0, 0, Timer - Start)

        'DoEvents release control ever so briefly to Windows. This
        'allows Windows to do stuff like update the screen. When you
        'have loops like this, your code appears frozen because it's
        'not letting Windows do anything (unless you have this line)
        DoEvents
    Loop
End Sub

Answer 1

我会尝试使用 Application.OnTime

的其他方法

修改

Public iCounter As Date 'Time Value Public Sub CountDownValue() Dim rCell, sSheet As String rCell = "A1" 'target cell holding timer value sSheet = "Sheet1" 'target sheet If Sheets(sSheet).Range(rCell).Value > 0 Then Sheets(sSheet).Range(rCell).Value = TimeSerial(DateTime.Hour(Sheets(sSheet).Range(rCell).Value), DateTime.Minute(Sheets(sSheet).Range(rCell).Value), DateTime.Second(Sheets(sSheet).Range(rCell).Value) - 1) Application.OnTime Now + TimeSerial(0, 0, 1), "CountDownValue" End If End Sub Public Sub StartCountDown() iCounter = TimeSerial(0, 1, 10) 'how many seconds you want to start countdown with Dim rCell, sSheet As String sSheet = "Sheet1" 'target sheet rCell = "A1" 'target cell holding timer value 'start new countdown Sheets(sSheet).Range(rCell).Value = iCounter Call CountDownValue End Sub

在单元格中输入值时，代码不会被中断。尽管如此，您将看到如果您开始将长公式写入单元格，您的计时器将被暂停，直到您释放单元格（按Enter键或移动到任何其他单元格）。如果你想要更可靠的计数器，我可能会采用不同的方法。

Answer 2

将您的活动日期@ cell A1。
- 右键单击＆gt;格式＆gt;显示日期和时间时间
- 以擅长阅读时间和日期的方式输入。
将此公式放在下一个单元格（或其他单元格）

=(INT(A1-NOW()))&" Day "&(IF(HOUR(A1)<=HOUR(NOW()),(HOUR(A1)-HOUR(NOW())+24),(HOUR(A1)-HOUR(NOW()))))&" Hour "&(IF(MINUTE(A1)<=MINUTE(NOW()),(MINUTE(A1)-MINUTE(NOW())+60),(MINUTE(A1)-MINUTE(NOW()))))&" Minute "&(IF(SECOND(A1)<=SECOND(NOW()),(SECOND(A1)-SECOND(NOW())+60),(SECOND(A1)-SECOND(NOW()))))&" Second to go."

按回车键。
- 完成。一个计时器，没有vba。
- 捕获：只有当单元格上有任何更改/输入时，计时器才会自行更新。它不会像vba那样“活”。（对我来说很好......，可能不适合其他人）。

希望有所帮助。（^ _ ^）\

参考：

https://stevechasedocs.wordpress.com/2014/11/19/create-a-countdown-timer-with-dates-in-excel/

如何在Excel中使用倒计时器，在输入时继续

2 个答案: