исправте код

[Screame]

У меня есть код:

Private Sub Worksheet_Change(ByVal Target As Range)   
Dim vVal   
Dim StrVal As String   
Dim dDate As Date   
  
    If Target.Cells.Count > 1 Then Exit Sub   
    If Not Intersect(Target, Range("A2:A10")) Is Nothing Then   
        With Target   
        StrVal = Format(.Text, "000000")   
        If IsNumeric(StrVal) And Len(StrVal) = 6 Then   
            Application.EnableEvents = False   
            dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))   
            .NumberFormat = "dd/mm/yyyy"   
            .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))   
           End If   
        End With   
   End If  
Application.EnableEvents = True   
 
End Sub

При его использование у меня возникают некоторые проблемы: 1. В случае неправильного формата введенных данных (5809 вместо 050809) срабатывает ошибка и останавливается выполнения макроса, нужно чтобы вслучае неверного ввода данных срабатывал какой нибуть обработчик ошибок и не преривалась работа макроса. 2. После срабатывания стандартного обработчика ошибок VBA после того как нажимаю END начинает неправильно выводить даты с этим тоже нужно както справится. Помогиите кто может!!!

[doober]

Не понимаю,как должен был работать код при пустом значении

Private Sub Worksheet_Change(ByVal Target As Range)
Dim StrVal, sl As String
Dim dDate As Date
   
  
   If Target.Cells.Count > 1 Then Exit Sub
 
   
    If Not Intersect(Target, Range("A2:A10")) Is Nothing Then
        With Target
      
    StrVal = Target.Cells.Value
 
        If IsNumeric(StrVal) And Len(StrVal) = 6 Then

Application.EnableEvents = False

       sl = Left(StrVal, 2) & "." & Mid(StrVal, 3, 2) & "." & "20" & Right(StrVal, 2)
            On Error GoTo 10
            dDate = DateValue(sl)
       
            .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))
            .NumberFormat = "dd/mm/yyyy"
            
       
           Else
           
          GoTo 10
               End If
           
        End With
   End If
 GoTo 20
10

Target.Cells.Value = ""
20
Application.EnableEvents = True
End Sub

[Screame]

doober, Ваш код у меня вообще неработает, оставляет либо пустую ячейку, либо вводит совсем другую дату, а не ту что ввел. Помогите кто может!!!!!!!!!!

[doober]

Работает нормально,посмотри ролик.

[Screame]

теперь я вижу что не так посмотрите на пример!!!

[The_Prist]

Кажись так.

Private Sub Worksheet_Change(ByVal Target As Range)   
Dim vVal   
Dim StrVal As String   
Dim dDate As Date   
  
    If Target.Cells.Count > 1 Then Exit Sub   
    If Target = "" Then Exit Sub 
    If Not Intersect(Target, Range("A2:A10")) Is Nothing Then   
        With Target     
        If IsNumeric(Target) And Len(Target) = 6 Then   
            Application.EnableEvents = False   
            StrVal = Format(.Text, "000000") 
            dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))   
            .NumberFormat = "dd/mm/yyyy"   
            .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))   
           End If   
        End With   
   Else
        msgbox "Введенные данные должны быть числом и содержать только 6 символов!",vbcritical,"Ошибка ввода"
        Application.EnableEvents = False 
        Target = ""
   End If  
Application.EnableEvents = True   
 
End Sub

а по второму вопросу, просто необходимо заново включить отслеживание событий

Application.EnableEvents = True

[Screame]

The_Prist сжальтесь надо мной, тоже самое, если я ввожу например 05.08.09 получается 50809, хотя должно получится 05.08.2009, дата необязательно должна начинатся с 05 также могут быть и другие числа например 06, 07, 08, и т.д.

[The_Prist]

Вы напишите какие комбинации будут вводится. А то Вы пишите

"ввожу 05.08.09 и получается 50809"

код это не обработает.
Вы с точками вводите? Для чего Вы планируете использовать код? Переводить введенные без точек числа в даты?

[Screame]

да хотелось както чтоб по проще даты было вводить набрал число и вот тебе дата, так намного проще чем вводить каждый раз 12/08/09, особенно с ноута, когда пальцы привыкли к обыкновенной клаве!

[doober]

Исправил,теперь работает правильно