Notifications
Clear all

Data Sem Barra

2 Posts
2 Usuários
0 Reactions
1,250 Visualizações
(@engadriano)
Posts: 9
Active Member
Topic starter
 

Prezados:
Utilizo uma macro do excel para digitar as datas sem digitar as barras (“/”).

Caso a data seja digitada com as barras, aparece uma mensagem de erro.
Acontece que qualquer data dentro do período de 29/05/82 a 24/11/1990 (não sei se com outros períodos também acontece) que for digitada com as barras, não dá erro e a mensagem de erro não aparece, e o excel entende a data inserida como um número.

Caso seja desabilitado o “Case 5” da macro, este problema não acontece, mas ai o excel não reconhece as datas que começam com zero.

Teria como resolver este problema?

Encontrei outra macro bem parecida com a que utilizo, mas também acontece o mesmo problema.

MACRO QUE UTILIZO:

Public Sub Worksheet_Change(ByVal Target As Range)
'Função para entrar Datas sem digitar as "/"
Dim DateStr As String, C1, C2
Select Case Target.Cells.Count
Case Is > 1
For Each C1 In Range(Target.Address)
For Each C2 In Range("A1:A25")
If C1.Address = C2.Address Then
If FLAG Then
Selection.Delete
FLAG = Not FLAG
Exit Sub
End If
Exit Sub
End If
Next C2
Next C1
Exit Sub
Case Else
If Application.Intersect(Range(Target.Address), _
Range("A1:A25")) Is Nothing Or _
Target.Value2 = "" Then Exit Sub
End Select
On Error GoTo EndMacro
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 1 'ex: 1 = 00/00/01
DateStr = "01/01/0" & .Formula
Case 2 'ex: 12 = 00/00/12
DateStr = "01/01/" & .Formula
Case 3 'ex: 123 = 00/01/23
DateStr = "01/0" & Left(.Formula, 1) & "/" & Right(.Formula, 2)
Case 4 'ex: 1234 = 00/12/34
DateStr = "01/" & Left(.Formula, 2) & "/" & Right(.Formula, 2)
Case 5 'ex: 12345 = 01/23/45
DateStr = Left(.Formula, 1) & "/" & Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
Case 6 'ex: 123456 = 12/34/56
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 7 'ex: 1234567 = 12/34/567
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case 8 'ex: 12345678 = 12/34/5678
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
End Select
Application.EnableEvents = False
.Formula = DateValue(DateStr)
End If
End With
GoTo Fim
EndMacro:
Target.Value = "" 'limpa a célula
Range(Target.Address).Select
MsgBox "As datas deverão ser inseridas no formato ddmmaa, sem as barras.", vbInformation, "DATA INVÁLIDA !!!!!"
Fim:
Application.EnableEvents = True
End Sub
    
MACRO QUE ENCONTREI NA INTERNET:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim DateStr As String
On Error GoTo EndMacro
If Intersect(Target, Range("A1:A25")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
With Target
If .HasFormula = False Then
Select Case Len(.Formula)
Case 5
DateStr = Left(.Formula, 1) & "/" & Mid(.Formula, 2, 2) & "/" & Right(.Formula, 2)
Case 6
DateStr = Left(.Formula, 2) & "/" & Mid(.Formula, 3, 2) & "/" & Right(.Formula, 2)
Case Else
Err.Raise 0
End Select
.Formula = DateValue(DateStr)
End If
End With
Application.EnableEvents = True
Exit Sub
EndMacro:
MsgBox "As datas deverão ser inseridas no formato ddmmaa, sem as barras.", vbInformation, "DATA INVÁLIDA !!!!!"
Range(Target.Address).ClearContents
Application.EnableEvents = True
End Sub

Agradeço que puder ajudar.

AdrianoPires

 
Postado : 09/03/2015 2:51 pm
(@cfirmino)
Posts: 3
New Member
 

Boa noite Adriano

Espero que este código te atenda.
Ele está setado para rodar na coluna A, se for outra vc altera.

Se houver algum erro me avise, pois fiz o código agora e estou com sono rs...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

On Error Resume Next

rn = Mid(Target.Address, 2, 1)

If rn = "A" Then 'verifica se a célula digitada está na coluna A
  If Not IsDate(Target.Cells.Value) Then
    Target.Cells.Value = DataCorrigida(Target.Cells.Value)
  End If
 End If
End Sub


Function DataCorrigida(strData As String)


Dim dData As Date

If IsNumeric(strData) Then
  If Len(strData) = 8 Then
    DataCorrigida = DateSerial(Right(strData, 4), Mid(strData, 3, 2), Left(strData, 2))
  Else
    DataCorrigida = DateSerial(Right(strData, 4), Mid(strData, 2, 2), Left(strData, 1))
  End If
Else
  MsgBox "Você não digitou uma data válida!"
  Target.Cells.Clear
End If
End Function
 
Postado : 13/03/2015 10:12 pm