Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Como alterar uma cé...
 
Notifications
Clear all

Como alterar uma célula que contenha letras e números?

 
2024 - VBA & Macros
Post Recente por anonimo20 8 anos atrás
6 Posts
2 Usuários
0 Reactions
1,482 Visualizações
RSS
 anonimo20
(@anonimo20)
Posts: 12
Eminent Member
Topic starter
 

Boa Tarde!

Possuo uma dúvida e ficaria muito grato se alguém pudesse me ajudar.

Tenho que automatizar uma planilha de fluxo de caixa, tenho um certo conhecimento em excel, mas não consegui achar solução p/ o seguinte caso:

Em uma coluna da minha planilha existem dados que preciso deletar, as celulas que tiverem números e letras devem permanecer, as que tiverem pontos devem permanecer, se estiverem vazias também, só preciso deletar o que tiver apenas letras, exemplo:

I12-C01101 (Deve permanecer)
99,77-Bradesco (Deve permanecer)
99,78-Bicbanco (Deve permanecer)
Não pagar (Deve ser deletado)
P/I12/12/000223 (Deve permanecer)
PPB - ABC (Deve ser deletado)
. (Deve permanecer)

Gostaria de usar Looping com select case, no exemplo a seguir meu looping pinta de laranja cada célula da seleção que seja um número (preciso que ele delete o que possuir apenas letras como descrevi acima):

Sub Colorir_PPB()

Dim Cell As Range
    
    For Each Cell In Selection
        Select Case IsNumeric(Cell)
            Case True
                Cell.Select
                Selection.Interior.Color = RGB(254, 72, 25)
        End Select
    Next Cell

End Sub

Estou aberto a idéias diferentes que possam resolver meu problema.

Desde já agradeço.

 
Postado : 09/04/2017 10:05 am
Syrax
 Syrax
(@syrax)
Posts: 160
Estimable Member
 

Envia um exemplo ou a planilha, fica mais fácil

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

 
Postado : 09/04/2017 10:16 am
Syrax
 Syrax
(@syrax)
Posts: 160
Estimable Member
 

Veja se isso te ajuda

Substitua "A" pela coluna onde estão os seus dados

Sub apagar_dados()
Dim i As Object
Set i = CreateObject("vbscript.regexp")
i.Global = True
i.ignorecase = True
i.Pattern = "([d+.])"
For a = 1 To Range("A1048576").End(xlUp).Row + 1 'substitua o "A" pela coluna onde estão os seus dados
If i.test(Range("A" & a).Value) = False Then 'substitua o "A" pela coluna onde estão os seus dados
Range("A" & a).Clear 'substitua o "A" pela coluna onde estão os seus dados
End If
Next a
End Sub

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

 
Postado : 09/04/2017 10:58 am
 anonimo20
(@anonimo20)
Posts: 12
Eminent Member
Topic starter
 

Syrax

Boa noite amigo!

Funcionou, mas eu esqueci de citar que o código deve ignorar células vazias, células que contenham a palavra "Atribuição" e células que contenham a palavra "linha",
Poderia me ajudar nessa ficaria muito grato!

Anexei um exemplo do que deve ser deletado.

Exemplo.zip
 
Postado : 09/04/2017 3:53 pm
Syrax
 Syrax
(@syrax)
Posts: 160
Estimable Member
 

Sempre há um porém ou algo que não foi dito
Não se esqueça de dizer todos os detalhes ou dizer tudo o que você precisa na próxima vez, pois isso dificulta mais ainda a ajuda

Veja se isso te ajuda, se sim, clique no "joinha" o lado de citar. Não se esqueça de colocar o tópico como RESOLVIDO

Sub apagar_dados()
Dim i As Object
Set i = CreateObject("vbscript.regexp")
i.Global = True
i.ignorecase = True
i.Pattern = "([d+.]|Atribuição|linha)"
For a = 1 To Range("B1048576").End(xlUp).Row + 1
If i.test(Range("B" & a).Value) = False Then
Range("B" & a).Clear
End If
Next a
End Sub

Se essa resposta te ajudou e resolveu o seu problema, clique no "joinha" ao lado de citar, e não esqueça de colocar o tópico como resolvido, clicando no ✓

 
Postado : 09/04/2017 4:46 pm
 anonimo20
(@anonimo20)
Posts: 12
Eminent Member
Topic starter
 

Syrax

Me ajudou muito amigo!
Para as células vazias que não podem ser deletadas fiz um looping que atribui um "." p / o valor de cada uma e depois a sua macro é executada.
Muito obrigado!!!

 
Postado : 09/04/2017 6:48 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico