Private Sub Worksheet_Change(ByVal Target As Range)
    Dim collValidDates As New Collection, boolError As Boolean
    Dim arr, i As Long
    
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    If Target.Row = 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    arr = Split(Target.Validation.Formula1, ";")
    For i = 0 To UBound(arr)
        collValidDates.Add Item:="", Key:=arr(i)
    Next i
    On Error Resume Next
        If collValidDates(CStr(Target.Value)) = "" Then
        End If
        If Err.Number <> 0 Then
            boolError = True
        End If
    On Error GoTo 0
    If boolError = False Then Exit Sub
    Application.EnableEvents = False
    Application.Undo
    Application.EnableEvents = True
    MsgBox "Введены недопустимые данные!", vbCritical
End Sub