Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$J$1" Then
        Application.EnableEvents = False
        Target = CellDatValid(Target.Value)
        Application.EnableEvents = True
    End If
End Sub


Function CellDatValid(datText$) As String
    Dim spl, i&

    If Len(datText) Then
        For i = 1 To Len(datText)
            If Not IsNumeric(Mid$(datText, i, 1)) Then Mid$(datText, i, 1) = "."
        Next
    End If
    If Len(datText) = 1 Then
        If IsNumeric(datText) Then
            If datText = 0 Then GoTo Exit_Error
            datText = datText & ".1"
            GoTo Exit_Valid
        Else
            GoTo Exit_Error
        End If

        ' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    ElseIf Len(datText) = 2 Then
        If Not IsNumeric(datText) Then
            datText = datText & "01"
        Else
            datText = datText & ".01"
        End If


        If IsDate(datText) Then
            If datText = Format(datText, "d.mm") Then GoTo Exit_Valid Else GoTo Exit_Error
        Else
            GoTo Exit_Error
        End If

        ' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    ElseIf Len(datText) = 3 Then
        If Not IsNumeric(datText) Then
            spl = Split(datText, ".")
            If UBound(spl) > 1 Then GoTo Exit_Error
            If spl(0) = "" Then GoTo Exit_Error
            spl(0) = Format(spl(0), "00")
            If spl(1) = "" Then spl(1) = "01"
            spl(1) = Format(spl(1), "00")
            datText = Join(spl, ".")
            If datText = Format(datText, "dd.mm") Then GoTo Exit_Valid Else GoTo Exit_Error
        Else
            ' число  3 знака
            GoTo Exit_Error1
        End If

        ' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    ElseIf Len(datText) = 4 Then
        If Not IsNumeric(datText) Then
            ' не число  4 знака

            If Right$(datText, 1) = "." Then datText = Left$(datText, 3)
            spl = Split(datText, ".")
            If UBound(spl) > 1 Then GoTo Exit_Error
            If spl(0) = "" Or spl(1) = "" Then GoTo Exit_Error
            spl(0) = Format(spl(0), "00")
            spl(1) = Format(spl(1), "00")
            datText = Join(spl, ".")

            If datText = Format(datText, "dd.mm") Then GoTo Exit_Valid Else GoTo Exit_Error
        Else
            ' число  4 знака

            datText = Left$(datText, 2) & "." & Right$(datText, 2)
            If datText = Format(datText, "dd.mm") Then GoTo Exit_Valid Else GoTo Exit_Error

        End If

        ' &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    ElseIf Len(datText) > 4 Then
        If Not IsNumeric(datText) Then
            ' не число свыше 4 знаков
            spl = Split(datText, ".")
            If UBound(spl) > 2 Then GoTo Exit_Error
            If spl(0) = "" Or Len(spl(0)) > 2 Then GoTo Exit_Error
            If spl(1) = "" Or Len(spl(1)) > 2 Then GoTo Exit_Error
            spl(0) = Format(spl(0), "00")
            spl(1) = Format(spl(1), "00")
            datText = Join(spl, ".")
            If UBound(spl) = 2 Then
                If IsDate(datText) Then
                    If Len(spl(2)) < 3 Then
                        spl(2) = Format(spl(2), "00")
                        datText = Join(spl, ".")
                        If datText = Format(datText, "dd.mm.yy") Then GoTo Exit_Valid Else GoTo Exit_Error

                    ElseIf Len(spl(2)) > 3 Then
                        If datText = Format(datText, "dd.mm.yyyy") Then GoTo Exit_Valid Else GoTo Exit_Error
                    Else
                        GoTo Exit_Error2
                    End If
                Else
                    GoTo Exit_Error
                End If

            Else
                If IsDate(datText) Then
                    If datText = Format(datText, "dd.mm") Then GoTo Exit_Valid Else GoTo Exit_Error
                Else
                    GoTo Exit_Error
                End If
            End If
        Else
            ' число свыше 4 знаков
            If Len(datText) = 7 Then GoTo Exit_Error1
            If Len(datText) < 7 Then
                datText = Left$(datText, 2) & "." & Mid$(datText, 3, 2) & "." & Format(Mid$(datText, 5), "00")

                datText = Format(datText, "dd.mm.yyyy")

            Else
                datText = Left$(datText, 2) & "." & Mid$(datText, 3, 2) & "." & Mid$(datText, 5)
            End If
            If IsDate(datText) Then
                If datText = Format(datText, "dd.mm.yyyy") Then GoTo Exit_Valid Else GoTo Exit_Error
            Else
                GoTo Exit_Error
            End If
        End If


    End If
    Exit Function

Exit_Valid:
    '        MsgBox "OK   " & Format(datText, "dd.mm.yyyy")
    CellDatValid = Format(datText, "dd.mm.yyyy")
    Exit Function
Exit_Error:
    MsgBox "Ошибка ввода даты!", vbExclamation, "ПРОВЕРКА ДАТЫ"
    CellDatValid = ""
    Exit Function
Exit_Error2:
    MsgBox "Год нельзя вводить трехзначным числом!", vbExclamation, "ПРОВЕРКА ДАТЫ"
    CellDatValid = ""
    Exit Function
Exit_Error1:
    MsgBox "Используйте четное число символов или разделитель!", vbExclamation, "ПРОВЕРКА ДАТЫ"
    CellDatValid = ""

End Function