InputBox 输入时间，带验证

Question

我希望当用户在 A 列的单元格中输入值时，应该弹出一个输入框询问时间。我希望 C 列中该输入框的输出与在 A 列中输入值的位置在同一行中。我希望每次在 A 中输入某些内容时都会发生这种情况。

• 如果A1被填满，则询问时间并放入C1。
• 如果A4被填满，则询问时间并放入C4。

如果时间没有输入或输入不正确（hh:mm），我也想要一个消息框，说时间没有正确输入，然后循环回到输入框。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Dim xRtn As Variant
    
    Set KeyCells = Range("A1:A100")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then    
        Do Until Not xRtn = 0 Or Format(xRtn, "hh:mm")
            xRtn = Application.InputBox("Wat is de tijd dat het monster genomen is?" & vbNewLine & "Gebruik UU:MM" & vbNewLine & "Voorbeeld: 09:30", "Tijdnotatie")
            Columns("C").Value = xRtn
            If xRtn = 0 Then
                If Not MsgBox("Een correcte tijdsnotatie is nodig om door te gaan. Klik op" & vbNewLine & "<Ok> om de tijd opnieuw in te vullen", vbOK + vbDefaultButton1 + vbExclamation, vbNullString) = vbOK Then
                End If
            End If
        Loop
    End If
End Sub

Answer 1

类似下面的东西就可以了。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Cells.Count > 1 Then Exit Sub 'abort if more than one cell was changed
    
    'only run the code if a cell in column A was changed
    If Not Intersect(Target, Me.Columns("A")) Is Nothing Then
        'ask for time and write it 2 columns right of the target cell
        Target.Offset(ColumnOffset:=2).Value = AskForValidTime
    End If
End Sub


Private Function AskForValidTime() As String
    Dim IsValid As Boolean
    
    Do Until IsValid
        Dim Result As Variant
        Result = Application.InputBox("Wat is de tijd dat het monster genomen is?" & vbNewLine & "Gebruik UU:MM" & vbNewLine & "Voorbeeld: 09:30", "Tijdnotatie")
        
        'test if time is a valid time with less than 24 hours and less than 60 minutes
        Dim SplitTime() As String
        SplitTime = Split(Result, ":")
        If UBound(SplitTime) = 1 Then
            If Val(SplitTime(0)) < 24 And Val(SplitTime(1)) < 60 Then
                IsValid = True
                AskForValidTime = Result
                Exit Do
            End If
        End If

        MsgBox "Een correcte tijdsnotatie is nodig om door te gaan. Klik op" & vbNewLine & "<Ok> om de tijd opnieuw in te vullen", vbOKOnly + vbExclamation, vbNullString
    Loop
End Function

但请注意，这会强制用户输入有效时间。如果他不这样做，他将无法中止此操作或退出此操作。

我将用于询问和验证的代码拆分为一个单独的函数AskForValidTime，以防您也需要在其他地方使用相同的东西。这样代码可以很容易地重复使用。

Answer 2

您可以只自动输入时间，而不是为它弹出一个框，然后检查以确保它们没有搞砸。

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 Then
    Range("C" & Target.Row).Value = Format$(Now, "hh:mm")
  End If
End Sub