Блог

Я хочу, чтобы, когда пользователь вводит значение в ячейку в столбце A, должно появиться поле ввода с запросом времени. Я хочу, чтобы вывод этого поля ввода в столбце C находился в той же строке, в которой значение было введено в столбце A. Я хочу, чтобы это происходило каждый раз, когда что-то вводится в A.

• Если A1 заполнен, запрашивается время и вводится в C1.
• Если затем заполнен A4, запрашивается время и вводится в C4.

Я также хочу, чтобы, если время не введено или введено неправильно (чч: мм), то окно сообщения, в котором указано, что время введено неправильно, затем возвращалось к inputbox.

 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?" amp; vbNewLine amp; "Gebruik UU:MM" amp; vbNewLine amp; "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" amp; vbNewLine amp; "<Ok> om de tijd opnieuw in te vullen", vbOK   vbDefaultButton1   vbExclamation, vbNullString) = vbOK Then
                End If
            End If
        Loop
    End If
End Sub
 

Что-то вроде приведенного ниже сделало бы это.

 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?" amp; vbNewLine amp; "Gebruik UU:MM" amp; vbNewLine amp; "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" amp; vbNewLine amp; "<Ok> om de tijd opnieuw in te vullen", vbOKOnly   vbExclamation, vbNullString
    Loop
End Function
 

Но обратите внимание, что это заставляет пользователя вводить действительное время. Если он этого не сделает, он не сможет прервать это действие или выйти из него.

Я разделил код для запроса и проверки на отдельную функцию AskForValidTime на случай, если вам понадобится использовать то же самое где-то еще. Таким образом, код можно легко использовать повторно.

Вы можете просто ввести время автоматически, вместо того, чтобы открывать для него окно, а затем проверять, чтобы убедиться, что они не перепутались.

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