Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)  
   If Intersect(Target, Range("B2:B500")) Is Nothing Then Exit Sub  
   Application.EnableEvents = 0  
   On Error Resume Next  
   Target.NumberFormat = "general"  
   If Len(Target) < 6 And Len(Target) > 0 Then  
       If InStr(1, Target, ".") Then  
           Target = DateValue(Target & "." & Year(Target(0)))  
       Else  
           Target = DateSerial(Year(Target(0)), Month(Target(0)), Target)  
       End If  
   ElseIf Len(Target) = 0 Then Target = Target(0)  
   End If  
   Target.NumberFormat = "dd/mm/yyyy"  
   Application.EnableEvents = -1  
End Sub

ALT F8, выполнить Макрос1