Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Проверка ввода даты в ячейку по условию
 
Добрый день !

Пробую прописать условие на ввод в ячейку даты - не получается

Условия такие:
Разрешить ввод:  заносить в ячейку текст только в виде dd.mm.yyyy hh:mm  (05.07.2018 12:00)

Запретить  ввод:
1)текст  в виде dd.mm.yyyy - пример 05.07.2018
2)текст  в виде dd.mm.yy - пример 05.07.18

3)текcт в виде dd.mm.yyyy 00:00  - пример 05.07.2018 00:00  05.07.2018 00:20
до
текcт в виде dd.mm.yyyy 02:00  - пример 05.07.2018 02:00
Изменено: oleg355 - 2 Июн 2018 14:09:12
 
Ну тут пользовательская проверка данных, что число больше чем например 01.01.2018 и дробная часть больше чем 1/12 это не заблокирует ввод короткого года, но потребует ввода времени из правильного диапазона. Не у компа,  думаю или сами справитесь или другие помогут.
Изменено: БМВ - 2 Июн 2018 22:27:23
 
так вот пробовал - не получилось
функцию здесь нашел
https://www.planetaexcel.ru/techniques/7/97/
Код
Function MaskCompareMulti(txt As String, ParamArray masks()) As Boolean
    MaskCompareMulti = False
    For i = LBound(masks) To UBound(masks)
        If txt Like masks(i) Then MaskCompareMulti = True
    Next i
End Function

Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Excel.Range)
If sh.Name = "Таблица" Or sh.Name = "Таблица2" Then
  If MaskCompartMulti(Target.Text, "##.##.####", "##.##.##", "##.##.#### ##:00", "##.##.#### ##:01","##.##.#### ##:02") > 0 Then
Application.Undo
 MsgBox "Ввод запрещен !"
End If
End If
 End Sub
 
Изменено: oleg355 - 2 Июн 2018 14:28:09
 
oleg355, в дебри полезли. Все прлще делается бе vba.
 
Получилось так но это не подходит - нужно точное совпадение а не поиск в тексте  - как изменить функцию на точное совпадение ?
Код
Function MaskCompareMulti(txt As String, ParamArray masks()) As Boolean
    MaskCompareMulti = False
    For i = LBound(masks) To UBound(masks)
        If txt Like masks(i) Then MaskCompareMulti = True
    Next i
End Function
 
Private Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Excel.Range)
If sh.Name = "Таблица" Or sh.Name = "Таблица2" Then
If Not Intersect(ActiveCell, Range("N4:N5003")) Is Nothing Then
 If MaskCompareMulti(Target.Text, "##.##.####", "##.##.##", "##.##.#### 00:##", "##.##.#### 01:##", "##.##.#### 02:##") = True Then
Application.Undo
 MsgBox "Ввод запрещен !"
End If
End If
End If
End Sub
Изменено: oleg355 - 2 Июн 2018 15:25:05
 
Менять функцию нужно на точное совпадение  - на что Like заменить в функции чтоб точное совпадение искала ?
 
oleg355,  вы так упорно по VBA бьете, это действительно необходимо? Если данные заносятся в ячейку, то все проще.
 
Все справился - последовал вашим советам и Len < 10 добавил еще. Спасибо за совет БМВ !
Страницы: 1
Читают тему (гостей: 1)