Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Проверка ввода даты в ячейку по условию
 
#1
02.06.2018 14:05:18
Добрый день !

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

Условия такие:
Разрешить ввод:  заносить в ячейку текст только в виде 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 - 02.06.2018 14:09:12
 
 
 
#2
02.06.2018 14:19:46
Ну тут пользовательская проверка данных, что число больше чем например 01.01.2018 и дробная часть больше чем 1/12 это не заблокирует ввод короткого года, но потребует ввода времени из правильного диапазона. Не у компа,  думаю или сами справитесь или другие помогут.
Изменено: БМВ - 02.06.2018 22:27:23
По вопросам из тем форума, личку не читаю.
 
 
 
#3
02.06.2018 14:20:40
так вот пробовал - не получилось
функцию здесь нашел
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 - 02.06.2018 14:28:09
 
 
 
#4
02.06.2018 14:28:57
oleg355, в дебри полезли. Все прлще делается бе vba.
По вопросам из тем форума, личку не читаю.
 
 
 
#5
02.06.2018 15:14:09
Получилось так но это не подходит - нужно точное совпадение а не поиск в тексте  - как изменить функцию на точное совпадение ?
Код
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 - 02.06.2018 15:25:05
 
 
 
#6
02.06.2018 15:27:08
Менять функцию нужно на точное совпадение  - на что Like заменить в функции чтоб точное совпадение искала ?
 
 
 
#7
02.06.2018 21:30:10
oleg355,  вы так упорно по VBA бьете, это действительно необходимо? Если данные заносятся в ячейку, то все проще.
По вопросам из тем форума, личку не читаю.
 
 
 
#8
02.06.2018 22:00:09
Все справился - последовал вашим советам и Len < 10 добавил еще. Спасибо за совет БМВ !
 
 
 
Страницы: 1
Наверх