Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Быстрый ввод времени и проверка на коректность - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Быстрый ввод времени и проверка на коректность (Макросы/Sub)
Быстрый ввод времени и проверка на коректность
ASWP Дата: Суббота, 16.02.2019, 20:50 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 183
Репутация: 23 ±
Замечаний: 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
 
Ответить
СообщениеДобрый день. Я нашел макрос быстрого ввода времени, но вот сделать проверку корректности ввода времени не получается. Подскажите, как это можно сделать?
[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]

Автор - ASWP
Дата добавления - 16.02.2019 в 20:50
krosav4ig Дата: Воскресенье, 17.02.2019, 01:49 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2140
Репутация: 892 ±
Замечаний: 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]


email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
СообщениеЗдравствуйте.
[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]

Автор - krosav4ig
Дата добавления - 17.02.2019 в 01:49
ASWP Дата: Воскресенье, 17.02.2019, 10:38 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 183
Репутация: 23 ±
Замечаний: 0% ±

Excel 2007
krosav4ig, Спасибо, то что надо. А сли мне нужно добавить еще одну ячейку, то я просто же диапазон меняю, верно?
[vba]
Код
If Intersect(Target, Range("D9,E9")) Is Nothing Then Exit Sub
[/vba]


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

Сообщение отредактировал ASWP - Воскресенье, 17.02.2019, 10:40
 
Ответить
Сообщениеkrosav4ig, Спасибо, то что надо. А сли мне нужно добавить еще одну ячейку, то я просто же диапазон меняю, верно?
[vba]
Код
If Intersect(Target, Range("D9,E9")) Is Nothing Then Exit Sub
[/vba]

Автор - ASWP
Дата добавления - 17.02.2019 в 10:38
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Быстрый ввод времени и проверка на коректность (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2019 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!