Быстрый ввод времени и проверка на коректность

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Быстрый ввод времени и проверка на коректность (Макросы/Sub)

ASWP

Дата: Суббота, 16.02.2019, 20:50 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 183

Репутация: 24 ±

Замечаний: 0% ±

Excel 2007

Добрый день. Я нашел макрос быстрого ввода времени, но вот сделать проверку корректности ввода времени не получается. Подскажите, как это можно сделать?
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
    If Not Intersect(Target, Range("D9")) Is Nothing Then
        With Target
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                Application.EnableEvents = False
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[h]:mm"
            End If
        End With
     End If
     Application.EnableEvents = True
End Sub

[/vba]

К сообщению приложен файл: fvdtime.xlsb (14.0 Kb)

я знаю что ничего не знаю, но другие не знают и этого

Сообщение отредактировал ASWP - Суббота, 16.02.2019, 20:52

Ответить

krosav4ig

Дата: Воскресенье, 17.02.2019, 01:49 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Здравствуйте.
[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal, oRE As Object

    On Local Error Resume Next
    If Intersect(Target, Range("D9")) Is Nothing Then Exit Sub
    Application.EnableEvents = 0
    With Target
        Set re = CreateObject("vbscript.regexp")
        re.Pattern = "^([0-1][0-9]|2[0-3])[0-5][0-9]$"
        vVal = Format(.Value, "0000")
        If re.test(vVal) Then
            .Value = Application.Replace(vVal, 3, 0, ":")
            .NumberFormat = "h:mm"
        Else
            MsgBox "Введенные данные не соответствуют времени в формате ччмм"
            Application.Undo
        End If
    End With
    Application.EnableEvents = True
    Set re = Nothing
End Sub

[/vba]