Excel manipular partes da celula do excel pelo vba

[JOAO BATISTA DEJANO]

Ola Pessoal!

Eu sei que isso para vocês será brincadeira, mas para mim ta sendo o fim do mundo.

Fiz uma macro para manipular partes de uma celula do excel usando o vba assim:

 

Sub nascimento()
firstcel = Left(Range("D4"), 2)
midcel = Mid(Range("D4"), 3, 2)
finalcel = Right(Range("D4"), 4)
celula = firstcel & "/" & midcel & "/" & finalcel
Range("D4") = celula

End sub

 

Quando eu digito 15032019 na celula D4 deveria aparecer na mesma o seguinte: 15/03/2019

No entanto aparece: 15////2019

Ja fiz usando essas quatro variaveis,  ja fiz sem as variaveis e o resultado é o mesmo.

Só consegui fazer aparecer 15/3/2019 mudando a midcel assim: midcel=Mid(Range("D4"),4,1)

Estou executando essa macro automaticamente quando altero a celula D4.

Alguem pode me da uma luz a respeito.

Agradecimentos antecipados

 

 

[JOAO BATISTA DEJANO]

Bem Pessoal!

Acabei de descobrir que isso é porque eu estou usando a mesma celula, tanto para pegar os dados como para retorna-los.

Se eu mudar o destino final, colocar a variavel celula em outro celula, como a D5 por ex. funciona. Mas eu queria colocar na D4 mesmo.

Vou tentando aqui.

 

[Patropi]

Boa noite @JOAO BATISTA DEJANO

 

Experimente copiar o código abaixo e colar no módulo da planilha:

 

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    ' Função para entrar Datas sem usar "/"
    ' Por: JLM - José Luiz Martins em 28/08/2003
    Dim DateStr As String
    On Error GoTo EndMacro
    If Intersect(Target, Range("D4")) 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 4
                    DateStr = Left(.Formula, 1) & "/" & _
                    Mid(.Formula, 2, 1) & "/" & Right(.Formula, 2)
                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 7
                    DateStr = Left(.Formula, 1) & "/" & _
                        Mid(.Formula, 2, 2) & "/" & Right(.Formula, 4)
                Case 8
                    DateStr = Left(.Formula, 2) & "/" & _
                        Mid(.Formula, 3, 2) & "/" & Right(.Formula, 4)
                Case Else
                    Err.Raise 0
            End Select
            .Formula = DateValue(DateStr)
        End If
    End With
    Application.EnableEvents = True
    Exit Sub
EndMacro:
    MsgBox "Você não entrou com uma data válida."
    Range(Target.Address).ClearContents
    Application.EnableEvents = True
End Sub

Se foi útil, clique em Curtir.

 

[]s

[JOAO BATISTA DEJANO]

Olá Pessoal!!

Grande Patropi!! Obrigado pela ajuda.

Infelizmente amigo, essa macro não quis funcionar comigo. Acredito que eu tenha cometido algum erro. Sou muito principiante ainda. Eu não consegui ver onde ela direciona o resultado para a celula "D4". Não dá erro, mas não acontece nada também. Mas peguei uma ideia dela e funcionou. Ficou bem simples assim:

 

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target = "" Then Exit Sub
  If Len(Target) = 10 Then Exit Sub
   If Not Intersect(Target, Range("A3:J18")) Is Nothing Then

    Dim firstcel, midcel, finalcel, celula

     Select Case Target.Address
       Case "$I$3": Call data
        Case "$D$4": Call nascimento
          Case "$I$4": Call requerimento
            Case "$D$7": Call emprego_entrada
               Case "$G$7": Call emprego_saida
             Case "$E$9": Call especial_inicio
          Case "$G$9": Call especial_fim

       End Select
    End If
  End Sub

 

______________________________________________________________________________________________________

 

Sub nascimento()
     firstcel = Left(Range("D4"), 2)
           midcel = Mid(Range("D4"), 3, 2)
                   finalcel = Right(Range("D4"), 4)
         celula = firstcel & "/" & midcel & "/" & finalcel
     Range("D4") = celula
End Sub

 

------------------------------------------------------------------------------------------------------------------------------------------------------------------

 

Eu penso que o programa fica fazendo um loop em cima da celula alvo (target). Assim e limitei o tamanho dela em 10 caracteres.

Agora vou continuar estudando a macro para colocar as verificações de erro que aparece com  a digitação.

Aceito sugestões

 

 

 

[Visitante]

17 horas atrás, JOAO BATISTA DEJANO disse:

Acabei de descobrir que isso é porque eu estou usando a mesma celula, tanto para pegar os dados como para retorna-los.

Se eu mudar o destino final, colocar a variavel celula em outro celula, como a D5 por ex. funciona.

Não exatamente. O seu código "nascimento" funciona corretamente em D4 também. A desconfiguração do formato data (15////2019) provavelmente está ocorrendo posteriormente porque existe um código WS_Change que talvez esteja processando aquela célula mais de uma vez. Você só informou sobre a existência do código WS_Change no post #4.

Apesar de funcionar, o seu código "nascimento" insere um texto com aparência de data. Para converter o resultado em data acrescente uma cópia da linha abaixo.

[D4].TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, 4)

 

Segue um código que faz a conversão de um número existente em D4 (ddmmaaaa) em uma data real (dd/mm/aaaa).

Sub nascimento()
 [D4] = DateValue(Format([D4], "00\/00\/0000"))
End Sub

 

[JOAO BATISTA DEJANO]

Obrigado Osvaldomp!!!

Vou verificar e depois posto aqui!!!

 

[JOAO BATISTA DEJANO]

Ola Pessoal!!!

E aí grande mestre OsvaldoMP!!

Essa informação que você postou foi de grande valia. Já fiz vários testes com problemas que eu tive anterior  e me solucionou bem os problemas. Inclusive, deixaria a macro mais simples. Aprendi bastante. Mas uma coisa  que eu queria saber é como eu faço para mudar de formato americano para português brasileiro simples. Se houver, é claro. Ou seja: dd/mm/yyyy ao invés de mm/dd/yyyy. Ja verifiquei na net, tem, mais é um tanto quanto grande.

Agradecimentos antecipados!

[Visitante]

2 horas atrás, JOAO BATISTA DEJANO disse:

... como eu faço para mudar de formato americano para português brasileiro ... dd/mm/yyyy ao invés de mm/dd/yyyy.

 

O comando que passei no post #5 resulta em dd/mm/aaaa. Se no seu caso o resultado é diferente então disponibilize uma amostra do seu arquivo Excel com TODOS os códigos existentes.

[JOAO BATISTA DEJANO]

Ola Pessoal!!!

Saudações Mestrãos!!!

É o seguinte:

Nesse caso eu testei com o excel em branco. Abri o programa e só utilizei a célula D4 e G4 para depois eu fazer um datadif, para ver se ele calculava. Bem, eu consegui descobri o que estava errado. Se você formatar a célula como texto, ele da o resultado: mm/dd/yyyy. Se você formatar como geral ele da o resultado dd/mm/yyyy  que é o que eu quero. Se você formatar a célula como numero ele dá o resultado serial.  Mas para mim já valeu. Vou montar o resto da Macro dessa forma que economiza bastante comando. Quando eu salvar as entradas de dados inseridos e transporta-los para outra parte da planilha, eu formato as células como desejado. Vou postando aqui os erros e acertos.

Obrigado por equanto.

 

 

[JOAO BATISTA DEJANO]

Ola Pessoal!!!

Gente, me socorre aqui para eu tentar entender isso:

Eu fiz a seguinte rotina no vba:

 

    If Left((Range(Target.Address)), 2) > 31 Or Mid((Range(Target.Address)), 3, 1) <> "/" Then GoTo Erromsg
    If Mid((Range(Target.Address)), 4, 2) > 12 Or Mid((Range(Target.Address)), 4, 2) < 1 Then GoTo Erromsg
    If Mid((Range(Target.Address)), 6, 1) <> "/" Then GoTo Erromsg
   ' If Format(Range(Target), 0) < 14611 Then GoTo Erromsg
   ' If Format(Range(Target), 0) > Format(Range("J3"), 0) Then GoTo Erromsg
    
 
    Range("D20") = Format(Range("D4"), 0)
    
    Range("J20") = Format(Range("J3"), 0)

 

Nela eu verifico  se o terceiro e o 6 digito são iguais a barras (/). Se não for eu vou para mensagem de erro.

Tambem verifico se os dois primeiros caracteres é maior que 31 e os 4º e 5º é maior que 12.

Isso tudo funciona perfeitamente.

As duas linhas seguintes eu estava comparando datas, então tentei transforma-las em serial. Para eu saber se o formato funcionava eu coloquei as outras duas linhas que faz isso sem o if. Assim nessas células ( D20 e J20) aparece a data em serial. E funciona certinho. Mas se eu usar as duas linhas  de comparação das datas, alem delas não funcionar as outras que transforma em serial também não. Eu até ache que fosse por erro e o programa estava saltando para o Erromsg. Mas para checar isso eu coloquei no lugar da barra uma letra e assim ele deu a mensagem de erro  de digitação. "voce não digitou uma data valida"

Também transferir as duas linhas para a rotina de erromsg para ver se ai ala mudava a celula D20 ou J20 e nada. Alguem sabe para onde o programa está indo.

Agradecimentos antecipados.

[JOAO BATISTA DEJANO]

Olá Pessoal!!

Consegui fazer uma macro para entrar com as datas sem digitar as barras e se quiser pode digitar as barras também.

No meu caso eu limitei uma parte da planilha onde vou usar isso.

Algumas limitações de tempo que eu coloquei é que no meu caso isso é util.

Tentei fazer correção do que é digitado também.

Fiquem a vontade para fazer correções e me dizer os erros o gafes que eu cometi. Como eu ja disse  aqui no forum , estou estudando vba. Sou bem iniciante. Espero que sirva para alguma coisa.

 

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    ' Função para entrar Datas sem usar "/"
    ' Pode ser digitadas as barras se quiser.
    ' Por: JBD - João Batista Dejano em 22/03/2019.
    
    On Error GoTo EndMacro
    
    If Intersect(Target, Range("A2:J18")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.EnableEvents = False
    
    If Len(Range(Target.Address)) = 10 Then GoTo ComBarras
    If Len(Range(Target.Address)) <> 8 Then GoTo Erromsg

SemBarras:
    
    If Asc(Mid(Range(Target.Address), 1)) < 48 Or Asc(Mid(Range(Target.Address), 1)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 2)) < 48 Or Asc(Mid(Range(Target.Address), 2)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 3)) < 48 Or Asc(Mid(Range(Target.Address), 3)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 4)) < 48 Or Asc(Mid(Range(Target.Address), 4)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 5)) < 48 Or Asc(Mid(Range(Target.Address), 5)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 6)) < 48 Or Asc(Mid(Range(Target.Address), 6)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 7)) < 48 Or Asc(Mid(Range(Target.Address), 7)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 8)) < 48 Or Asc(Mid(Range(Target.Address), 8)) > 57 Then GoTo Erromsg
    If Left((Range(Target.Address)), 2) > 31 Or Left((Range(Target.Address)), 2) < 1 Then GoTo Erromsg
    If Mid((Range(Target.Address)), 3, 2) > 12 Or Mid((Range(Target.Address)), 3, 2) < 1 Then GoTo Erromsg
    
    Target = Format([Target], "00/00/0000")
    
    If Format(Range(Target.Address), 0) < 14611 Or Format(Range(Target.Address), 0) > Format(Range("K3"), 0) Then
    GoTo Erromsg
    Else: GoTo EndMacro
    End If
    

ComBarras:
    
    If Asc(Mid(Range(Target.Address), 1)) < 48 Or Asc(Mid(Range(Target.Address), 1)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 2)) < 48 Or Asc(Mid(Range(Target.Address), 2)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 4)) < 48 Or Asc(Mid(Range(Target.Address), 4)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 5)) < 48 Or Asc(Mid(Range(Target.Address), 5)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 7)) < 48 Or Asc(Mid(Range(Target.Address), 7)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 8)) < 48 Or Asc(Mid(Range(Target.Address), 8)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 9)) < 48 Or Asc(Mid(Range(Target.Address), 9)) > 57 Then GoTo Erromsg
    If Asc(Mid(Range(Target.Address), 10)) < 48 Or Asc(Mid(Range(Target.Address), 10)) > 57 Then GoTo Erromsg
    If Left((Range(Target.Address)), 2) > 31 Or Left((Range(Target.Address)), 2) < 1 Then GoTo Erromsg
    If Mid((Range(Target.Address)), 3, 1) <> "/" Or Mid((Range(Target.Address)), 6, 1) <> "/" Then GoTo Erromsg
    If Mid((Range(Target.Address)), 4, 2) > 12 Or Mid((Range(Target.Address)), 4, 2) < 1 Then GoTo Erromsg
    
    If Format(Range(Target.Address), 0) < 14611 Or Format(Range(Target.Address), 0) > Format(Range("K3"), 0) Then
    GoTo Erromsg
    Else: GoTo EndMacro
    End If
    

Erromsg:

    MsgBox "Você não entrou com uma data válida."
    Range(Target.Address).ClearContents

EndMacro:
 
   Application.EnableEvents = True
   
    End Sub