none
Evento que ao digitar numeros numa determinadas celulas, insere como caracter RRS feed

  • Pergunta

  • Bom dia.

    Tenho numa planilha, uma determinada area, por exemplo A1:A10, onde quando o usuario digitar numeros ou alfanumericos, sempre saia inserido como caracter. Nao vale formatacao pois vou usar esses dados para validacoes, e se o usuario deixar como numero, dara erro. Tem como fazer com eventos de tal maneira que se digitasse nas celulas A1:A10 acionasse um evento que se for numero tranforme e insere em caracter, e se for caracter insere assim mesmo? Tera que usar uma outra area auxiliar?

    Desde ja agradeco a quem possa dar um retorno

    Tadao

    quinta-feira, 26 de janeiro de 2017 14:37

Respostas

  • Tadao,

    isto acontece porque o código que passei não trata múltiplas edições, gerando erro para estes casos. Para resolver teste:

    Dim NãoLimparEstáticas As Boolean           'Para recarregar as variáveis estáticas (False para Início)
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    '
    
    Static Limitador As Long
    Dim x As Range, Intervalo As Range
    
    Set Intervalo = Range("A1:A10")
    
    If Not NãoLimparEstáticas Then Limitador = 1: NãoLimparEstáticas = True
    
    If Limitador > 1 Then Exit Sub
    Limitador = Limitador + 1
    
    For Each x In Target
        If Not Intersect(x, Intervalo) Is Nothing Then
            If IsNumeric(x.Value2) And x.Value2 <> vbNullString Then x.Value = "'" & x.Value2 'CStr(x.Value2)
        End If
    Next
    
    NãoLimparEstáticas = False                  'Resetando para a próxima célula
    Limitador = 1
    End Sub
    

    Note que há uma variável em nível de módulo.


    Filipe Magno

    quarta-feira, 8 de fevereiro de 2017 19:23

Todas as Respostas

  • Acho que dá pra melhorar, mas o código abaixo funciona. Veja se consegue aproveitá-lo:

    Private Sub Worksheet_Change(ByVal Target As Range)
    '
    
    Static Limitador As Long
    
    Set Intervalo = Range("A1:A10")
    
    Limitador = Limitador + 1
    
    If Not Intersect(Target, Intervalo) Is Nothing Then
        
        If Limitador > 1 Then Limitador = 0: Exit Sub
        
        If IsNumeric(Target.Value2) Then Target.Value = "'" & Target.Value2 'CStr(Target.Value2)
        
    End If
    
    Limitador = 0
    End Sub

    Abraço.


    Filipe Magno

    sexta-feira, 27 de janeiro de 2017 01:09
  • Obrigado Felipe, funcionou direitinho.

    Agora vai evitar muitos probelas de digitacao.

    Tadao

    sexta-feira, 27 de janeiro de 2017 11:01
  • Bom dia Felipe, primeiro agradeco pela rotina que fez, que esta funcionando que e uma beleza.Obrigado

    Estou usando essa rotina numa validacao de dados lista, onde tenho um intervalo que defini como dinamico com a formula=Offset(NomeRange,0,0,Counta(NomeColuna),1).

    A intencao era deixar a lista dropdown sem espacos em branco com o intervalo definido como dinamico, mas o que  esta acontecendo e que quando preencho a lista com numeros, ela fica como string e tudo beleza, mas quando deleto os dados co Del sobra a spa '   e a formula Counta conta como dados, deixando espacos em branco nas ultimas listas do dropdown quando e deletado dados. Notei que quando deleta uma celula de cada vez, deixa as Aspas, mas quando deleta selecionando mais que uma celula, nao deixa a Aspa.

    Sera que da para fazer a rotina nao colocar aspas quando usa o Del?

    Tadao



    sexta-feira, 3 de fevereiro de 2017 12:31
  • Tente assim:

    Private Sub Worksheet_Change(ByVal Target As Range)
    '
    
    Static Limitador As Long
    
    Set Intervalo = Range("A1:A10")
    
    Limitador = Limitador + 1
    
    If Not Intersect(Target, Intervalo) Is Nothing Then
        
        If Limitador > 1 Then Exit Sub
        
        If IsNumeric(Target.Value2) And Target.Value2 <> vbNullString Then Target.Value = "'" & Target.Value2 'CStr(Target.Value2)
        
    End If
    
    Limitador = 0
    End Sub

    Obs.: perceba que uma vez inserida a " ' " na célula, mesmo se você digitar uma string esse caractere sempre estará presente, mesmo se você apagar o código. Isso para mim é um bug e a única forma que encontrei para apagá-la é utilizando a ferramenta de "Apagar Tudo" (borracha). De toda sorte isto não gera nenhum erro.


    Filipe Magno

    sexta-feira, 3 de fevereiro de 2017 22:07
  • Ohhhh...Felipe, agora ficou redondo...Obrigado.

    Nao entendi bem a Obs, sera que e para o caso anterior?. No caso anterior eu usei a borracha, dai a Aspa  Sumiu......mas sumiu tambem a cor amarela que tinha colcoado para destacar a area de preenchimento.....

    Tadao

    sábado, 4 de fevereiro de 2017 03:10
  • Olá Tadao.

    Não é para o caso anterior não. Mesmo se você inserir a " ' " manualmente verá que somente é possível apagá-la com a borracha. Se você escrever qualquer string numa célula que a já tenha recebido verá que ela passa a ser automaticamente inserida.

    Mas não se preocupe, não muda nada para seu caso. É apenas estética.

    Abraço.


    Filipe Magno

    terça-feira, 7 de fevereiro de 2017 21:55
  • Ola Felipe, eu coloquei o " ' " manualmente e apaguei com tecla Del.

    Agora eu consio apagar os dados errados com Del, mas uma de cada vez, se selecionar mais que uma celula e apertar a tecla Del da erro e para na linha 

    If IsNumeric(Target.Value2) And Target.Value2 <> vbNullString Then Target.Value = " ' " & Target.Value2 'CStr(Target.Value2)

    Porque sera?

    Tadao

    quarta-feira, 8 de fevereiro de 2017 14:11
  • Tadao,

    isto acontece porque o código que passei não trata múltiplas edições, gerando erro para estes casos. Para resolver teste:

    Dim NãoLimparEstáticas As Boolean           'Para recarregar as variáveis estáticas (False para Início)
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    '
    
    Static Limitador As Long
    Dim x As Range, Intervalo As Range
    
    Set Intervalo = Range("A1:A10")
    
    If Not NãoLimparEstáticas Then Limitador = 1: NãoLimparEstáticas = True
    
    If Limitador > 1 Then Exit Sub
    Limitador = Limitador + 1
    
    For Each x In Target
        If Not Intersect(x, Intervalo) Is Nothing Then
            If IsNumeric(x.Value2) And x.Value2 <> vbNullString Then x.Value = "'" & x.Value2 'CStr(x.Value2)
        End If
    Next
    
    NãoLimparEstáticas = False                  'Resetando para a próxima célula
    Limitador = 1
    End Sub
    

    Note que há uma variável em nível de módulo.


    Filipe Magno

    quarta-feira, 8 de fevereiro de 2017 19:23
  • Ohhh...Felipe, agora ficou Joia, nao da mais problema, Obrigado.

    Ja coloquei o Union para poder usar em varias areas.

    Antes de voce responder, .........estava experimentando.........resolver na base da tentativa, e coloquei um On Error Resume Next no comeco, e funcionou......, mas fiquei na duvida se talvez desse problemas para outras situacoes.

    Mais uma vez Obrigado pelas Atencoes.

    Tadao

    quinta-feira, 9 de fevereiro de 2017 07:36
  • Bom dia Tadao.

    "mas fiquei na duvida se talvez desse problemas para outras situacoes."

    De fato, para apagar as células a utilização de "On Error" atende, mas para múltiplas alterações, como inserir um valor simultaneamente em várias células (Ctrl+Enter, por exemplo) não funcionaria.

    Da forma que te passei deve atender a ambas as situações.

    Fico feliz que tenha funcionado para o que pretende.

    Abraço.


    Filipe Magno

    quinta-feira, 9 de fevereiro de 2017 10:33
  • Obrigado pela explancao, Felipe.

    Tudo foi um rande aprendizado.

    Tadao

    quinta-feira, 9 de fevereiro de 2017 10:48