Excel 带有分段变化的横幅的计时器

Question

尝试制作一个横幅，该横幅会在指定时间的不同部分发生变化。不同的片段是 15、20、25 分钟。我有一个设置页面，用户可以 select 来自组合框的段。然后显示工作流页面像这样：

这是横幅在 15 分钟的片段中应该做什么的示例（伪代码）：

        When it starts (15 remaining)
            TimeBanner = "Thinking Time"
        After 1 minute (14 remaining) 
            TimeBanner = "Response Time"
        after 10 minutes (3 remaining)
            TimeBanner = "Refine and Improve"
        after 14 minutes(1 remaining) 
            TimeBanner = "Submit"
        after 15 minutes (0 remaining)
            TimeBanner = "Time Up"

定时器工作，但横幅没有改变所以我想也许我只需要添加 DoEvents，但它不会改变

这是代码

Option Explicit

 Public interval As Date
 Sub timer()

     interval = Now + TimeValue("00:00:01")

     If Sheets("VSS").Range("D1").Value = 0 Then Exit Sub
     
    'Show the time elapsed
    Sheets("VSS").Range("D1").Value = Sheets("VSS").Range("D1").Value - TimeValue("00:00:01")
    DoEvents

    Sheets("VSS").Range("E3").Value = TimeBanner(Sheets("ControlData").Range("A7").Value, Minute(Sheets("VSS").Range("D1").Value))
    DoEvents
    
    'Show the Time Banner matching the Elapsed Time
    
   'MsgBox Minute(Sheets("VSS").Range("D1").Value)

   Application.OnTime interval, "timer"
   
   
   DoEvents

 End Sub

 Sub stop_timer()
        'Only allow 'Stop' if the timer has started
        
        Dim iMin As Integer
        iMin = Left(Format(Sheets("VSS").Range("D1").Value, "mm:ss"), 2)
        
        
     'i.e. if the time elapsed DOES NOT equal whatever they chose
     'It means that the timer has started
     
     If iMin <> Sheets("ControlData").Range("A7").Value Then
        Application.OnTime EarliestTime:=interval, Procedure:="timer", Schedule:=False
     End If
 End Sub

Sub reset_timer()
    Sheets("VSS").Range("D1").Value = "00:" & Sheets("ControlData").Range("A7").Value & ":00"
End Sub


Function TimeBanner(iTimeChosen As Integer, iElapsedTime As Integer) As String

Debug.Print "Time chosen: " & iTimeChosen & ", Elapsed " & dtElapsedTime

Select Case iTimeChosen

    Case 25
    
        Select Case iElapsedTime
            Case Is <= 25
                TimeBanner = "Thinking Time"
            Case Is <= 23
                TimeBanner = "Response Time"
            Case Is <= 5
                TimeBanner = "Refine and Improve"
            Case Is <= 1
                TimeBanner = "Submit"
            Case 0
                TimeBanner = "Time Up"
        End Select
        
    Case 20
            Select Case iElapsedTime
            Case Is <= 20
                TimeBanner = "Thinking Time"
            Case Is <= 18
                TimeBanner = "Response Time"
            Case Is <= 4
                TimeBanner = "Refine and Improve"
            Case Is <= 1
                TimeBanner = "Submit"
            Case Is = 0
                TimeBanner = "Time Up"
            End Select
    
    Case 15
            Select Case iElapsedTime
            Case Is <= 15
                TimeBanner = "Thinking Time"
            Case Is <= 14
                TimeBanner = "Response Time"
            Case Is <= 3
                TimeBanner = "Refine and Improve"
            Case Is <= 1
                TimeBanner = "Submit"
            Case Is = 0
                TimeBanner = "Time Up"
            End Select
End Select

End Sub

Answer 1

你的第一个案例Select案例总是会在后续案例之前触发。如果 Case Is < 14 那么 Case Is <=15 也成立。

Case 15
    Select Case iElapsedTime
    Case Is <= 15
        TimeBanner = "Thinking Time"
    Case Is <= 14
        TimeBanner = "Response Time"
    Case Is <= 3
        TimeBanner = "Refine and Improve"
    Case Is <= 1
        TimeBanner = "Submit"
    Case Is = 0
        TimeBanner = "Time Up"
    End Select

删除 < 标志将使代码正常工作。

Function TimeBanner(iTimeChosen As Integer, iElapsedTime As Integer) As String

    Debug.Print "Time chosen: " & iTimeChosen & ", Elapsed " & dtElapsedTime

    Select Case iTimeChosen

    Case 25
    
        Select Case iElapsedTime
        Case Is < 25
            TimeBanner = "Thinking Time"
        Case Is < 23
            TimeBanner = "Response Time"
        Case Is < 5
            TimeBanner = "Refine and Improve"
        Case Is < 1
            TimeBanner = "Submit"
        Case 0
            TimeBanner = "Time Up"
        End Select
        
    Case 20
        Select Case iElapsedTime
        Case Is < 20
            TimeBanner = "Thinking Time"
        Case Is < 18
            TimeBanner = "Response Time"
        Case Is < 4
            TimeBanner = "Refine and Improve"
        Case Is < 1
            TimeBanner = "Submit"
        Case 0
            TimeBanner = "Time Up"
        End Select
    
    Case 15
        Select Case iElapsedTime
        Case 15
            TimeBanner = "Thinking Time"
        Case Is < 14
            TimeBanner = "Response Time"
        Case Is < 3
            TimeBanner = "Refine and Improve"
        Case Is < 1
            TimeBanner = "Submit"
        Case 0
            TimeBanner = "Time Up"
        End Select
    End Select

End Function

Answer 2

反转你的案例条件的顺序。例如，Case Is <= 25 将始终触发 25 及以下的任何数字，即所有数字，因此始终执行第一个条件。

Excel 带有分段变化的横幅的计时器

Excel Timer with banner that changes in segments

vba

excel-2016