Страницы: 1
RSS
Макрос - проверка внесение даты
 
Добрый день уважаемые коллеги.

Помогите пожалуйста, возможно кто то знаком с таким макросом.

Мне необходимо настроить Excel файл таким образом, что бы в определенной колонке к примеру  F, User мог вводить данные исключительно в формате даты к примеру 16.03.2018.  И только ОДНУ дату, то есть без вот таких идией "16.03.2018-30-04-2018" , Без пробелов и других знаков, только обычная дата.
Хотелось бы, что бы если User вводит не верном формате, в таком случае вылезает месседж бокс - "Введите дату в форрмате "дд.мм.гггг".

Есть ли такие возможности у VBA?
 
вполне себе справляется проверка данных дата и там же сообщение можно настроить
Лень двигатель прогресса, доказано!!!
 
хотелось бы все же макрасом данную проверку сделать
 
Заказы в соседней ветке. Тут помогают. Пробуйте сделать сами и обращайтесь с конкретными вопросами. Как это сделать "правильно" уже отписались, а макросом Вам нужно смотреть в сторону процедуры Sub Worksheet_Change. Внутри процедуры проверять изменился ли нужный столбец, если изменился - проверять дата там или нет.  
Я не волшебник, я только учусь.
 
bobyjoy, Вот булева функция для проверки, является выражение датой по григорианскому календарю в формате ДД.ММ.ГГГГ

Код
Function isGregorianDate(data As String) As Boolean
 
    'Проверка, соответствует ли дата формату ДД.ММ.ГГГГ
    If Not data Like "##.##.####" Then
        isGregorianDate = False
        Exit Function
    End If
 
    Dim d As String, m As String, y As String
    d = Left(data, 2)   'день
    m = Mid(data, 4, 2) 'месяц
    y = Mid(data, 7, 4) 'год
     
    If (d = 0 Or m = 0 Or m > 12 Or y = 0 _
        Or ((m = 1 Or m = 3 Or m = 5 Or m = 7 Or m = 8 Or m = 10 Or m = 12) And d > 31) _
        Or ((m = 4 Or m = 6 Or m = 9 Or m = 11) And d > 30) _
        Or (m = 2 And Not (d < 29 Or (d < 30 And y Mod 4 = 0 _
                And (y < 1582 Or y Mod 100 <> 0 Or y Mod 400 = 0))))) _
    Then
        isGregorianDate = False
        Exit Function
    End If
     
    isGregorianDate = True
     
End Function


Дальше сами.
 
Привет!

В исходный текст листа:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("F")) Is Nothing Then
       If IsDate(Target) = False Then
       MsgBox "Введите дату в форрмате дд.мм.гггг"
       End If: End If
End Sub
Сравнение прайсов, таблиц - без настроек
Страницы: 1
Наверх