Я пытаюсь написать Excel VBA. Я новичок в их написании, поэтому стараюсь комбинировать коды, которые нашел при поиске в Google.

Идея состоит в том, чтобы пользователь вводил значение в ячейку в столбце A. Затем должно появиться поле ввода с запросом времени. Выходные данные этого поля ввода я хочу в столбце C в той же строке, где значение было введено в столбец A. Я хочу, чтобы это происходило каждый раз, когда что-то вводится в A. Итак, если A1 заполнен, то время запрашивается и помещается в C1 и если тогда A4 заполнен, я хочу, чтобы время было запрошено и помещено в C4.

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

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
1
Larsvane 1 Дек 2020 в 15:55

2 ответа

Лучший ответ

Что-то вроде ниже подойдет.

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 на тот случай, если вам понадобится использовать то же самое в другом месте. Таким образом, код можно легко использовать повторно.

0
Pᴇʜ 1 Дек 2020 в 13:42

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

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
0
braX 1 Дек 2020 в 13:09