Notifications
Clear all

APAGAR VALORES PELA COR

14 Posts
4 Usuários
0 Reactions
2,133 Visualizações
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

Boa noite galera,

Eu queria criar uma macro que pudesse apagar os valores da planilha, porem nem todas as abas possuem a mesma quantidade de colunas (com dados que podem ser apagados).

A aba "BSCAM-BAIXAS" é diferente da aba BPI por exemplo.

Portanto, a unica solução que eu achei é apagar pela cor, e seriam apenas os dados que estão em verde (RGB 0,128,0).

Eu tentei fazer o código, mas não está dando certo. Vai ficar um botão para cada aba, e deverá apagar apenas os dados daquela aba.

Obrigado !!

 
Postado : 07/02/2017 6:16 pm
(@adgere)
Posts: 76
Trusted Member
 

Aqui deu certo dessa forma, porém, acredito não ser muito pratico dessa forma, pois o codigo demora muito para executa.
talvez devesse delimitar o range de cada planilha...

Dim linha As Long
Dim coluna As Long
Dim ultimaColuna As Integer
Dim ultimaLinha As Long

ultimaLinha = ActiveSheet.Range("A7").End(xlDown).Row
ultimaColuna = ActiveSheet.Range("A7").End(xlToRight).Column

'LOOPIN PARA PERCORRER TODAS AS LINHAS A PARTIR DA LINHA
For linha = 1 To ultimaLinha

    For coluna = 1 To ultimaColuna

     'SE A LINHA TIVER A FONTE DA COR INFORMADA ELE LIMPA A LINHA INTEIRA APENAS DAQUELA COR
     'MsgBox Cells(linha, coluna).Font.Color
     If Cells(linha, coluna).Font.Color = 32768 Then
         Cells(linha, coluna).Clear
     End If

     Next
Next
 
Postado : 07/02/2017 7:30 pm
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

Aqui deu certo dessa forma, porém, acredito não ser muito pratico dessa forma, pois o codigo demora muito para executa.
talvez devesse delimitar o range de cada planilha...

Dim linha As Long
Dim coluna As Long
Dim ultimaColuna As Integer
Dim ultimaLinha As Long

ultimaLinha = ActiveSheet.Range("A7").End(xlDown).Row
ultimaColuna = ActiveSheet.Range("A7").End(xlToRight).Column

'LOOPIN PARA PERCORRER TODAS AS LINHAS A PARTIR DA LINHA
For linha = 1 To ultimaLinha

    For coluna = 1 To ultimaColuna

     'SE A LINHA TIVER A FONTE DA COR INFORMADA ELE LIMPA A LINHA INTEIRA APENAS DAQUELA COR
     'MsgBox Cells(linha, coluna).Font.Color
     If Cells(linha, coluna).Font.Color = 32768 Then
         Cells(linha, coluna).Clear
     End If

     Next
Next

Nossa, ela realmente demora demais mesmo. Não tem outra maneira de apagar mais rápido com este código ?
Eu não queria delimitar o range, porque cada aba vai ter um numero diferente de colunas, e eu só coloquei duas abas como exemplo, mas na verdade são mais abas. E delimitar um range pra cada aba, não sei se é tão pratico tambem.

Voce sabe se tem uma maneira mais pratica de apagar esses valores ?

 
Postado : 07/02/2017 8:32 pm
(@gabrsoares)
Posts: 7
Active Member
 

Pessoal, tudo bom?

O que acham de definir o cálculo de fórmulas como manual no início da execução da macro e depois restaurar para automático após o final?

O código seria o seguinte:

'Fórmulas em Manual
Application.Calculation = xlCalculationManual

'Fórmulas em Automático
Application.Calculation = xlCalculationAutomatic

Vi que o código aciona o método "clear" diversas vezes. Se o cálculo de fórmulas estiver automático elas serão recalculadas sempre que alguma célula for editada, o que impacta bastante a performance.

Qualquer dúvida falem comigo.

Abs
https://www.linkedin.com/in/consultorgabrielsoares

 
Postado : 07/02/2017 8:59 pm
brunoxro
(@brunoxro)
Posts: 698
Honorable Member
 

Boa noite guimatheus,

Teste desabilitando as atualizações de tela e o cálculo automático. Isso vai deixar a rotina bem mais rápida.

Sub ApagarValores()

    Dim R   As Range
    
'Desabilita as atualizações de tela e o calculo automático.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For Each R In Cells(7, 1).CurrentRegion
        
        If R.Font.Color = 32768 Then
            R.Value = Empty
        End If
    
    Next R
   'Volta a ativar.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub
 
Postado : 07/02/2017 9:04 pm
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

Pessoal, tudo bom?

O que acham de definir o cálculo de fórmulas como manual no início da execução da macro e depois restaurar para automático após o final?

O código seria o seguinte:

'Fórmulas em Manual
Application.Calculation = xlCalculationManual

'Fórmulas em Automático
Application.Calculation = xlCalculationAutomatic

Vi que o código aciona o método "clear" diversas vezes. Se o cálculo de fórmulas estiver automático elas serão recalculadas sempre que alguma célula for editada, o que impacta bastante a performance.

Qualquer dúvida falem comigo.

Abs
https://www.linkedin.com/in/consultorgabrielsoares

Ótima dica !! Realmente o processo melhorou, e ficou bem mais rápido. Obrigado pela ajuda !

 
Postado : 07/02/2017 9:14 pm
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

Boa noite guimatheus,

Teste desabilitando as atualizações de tela e o cálculo automático. Isso vai deixar a rotina bem mais rápida.

Sub ApagarValores()

    Dim R   As Range
    
'Desabilita as atualizações de tela e o calculo automático.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For Each R In Cells(7, 1).CurrentRegion
        
        If R.Font.Color = 32768 Then
            R.Value = Empty
        End If
    
    Next R
   'Volta a ativar.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Melhorou bastante mesmo bruno, esse código apagá somente as os dados dessa cor em qualquer planilha/aba então ? Poderia me explicar o que significa essa parte " For Each R In Cells(7, 1).CurrentRegion" ?

Caso possua alguma maneira de deixar mais rapido, por favor me avise !

 
Postado : 07/02/2017 9:15 pm
brunoxro
(@brunoxro)
Posts: 698
Honorable Member
 

guimatheus,

Utilizei rotina o For Each, dê uma olhada: https://www.youtube.com/watch?v=GU7thfYTVIQ

Cells(7, 1).CurrentRegion é para pegar a região que vai ser percorrida, R é um range que defini.

Você pode tentar deixar um pouco mais rápido 'apagando' o Excel, adicione:

Application.Visible = False
'---Código---'
Application.Visible = True

O Excel não vai ficar visível enquanto executa a macro.

att,

 
Postado : 07/02/2017 9:27 pm
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

guimatheus,

Utilizei rotina o For Each, dê uma olhada: https://www.youtube.com/watch?v=GU7thfYTVIQ

Cells(7, 1).CurrentRegion é para pegar a região que vai ser percorrida, R é um range que defini.

Você pode tentar deixar um pouco mais rápido 'apagando' o Excel, adicione:

Application.Visible = False
'---Código---'
Application.Visible = True

O Excel não vai ficar visível enquanto executa a macro.

Ele fica mais rápido mesmo. Porém o código não funciona em outras abas, apenas nas duas abas que te passei. Essa era a minha duvida desde o começo, apagar apenas os dados em verde sem delimitação de limite. Segue anexo para testes.

att,

 
Postado : 08/02/2017 6:18 am
brunoxro
(@brunoxro)
Posts: 698
Honorable Member
 

Boa noite guimatheus,

Esse código quando executado vai buscar e apagar em todas as planinhas do arquivo.

Sub ApagarValores()

    Dim R   As Range
    Dim i   As Integer
    Dim NWs As Integer: NWs = Worksheets.Count

    'Desabilita as atualizações de tela e o calculo automático.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.Visible = False
    
    For i = 1 To NWs
                
        For Each R In Worksheets(i).UsedRange
            
            If R.Font.Color = 32768 Then
                R.Value = Empty
            End If
        
        Next R
    
    Next i
    
   'Volta a ativar.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Visible = True
    
End Sub

Teste e de retorno.

 
Postado : 08/02/2017 7:58 pm
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

Boa noite guimatheus,

Esse código quando executado vai buscar e apagar em todas as planinhas do arquivo.

Sub ApagarValores()

    Dim R   As Range
    Dim i   As Integer
    Dim NWs As Integer: NWs = Worksheets.Count

    'Desabilita as atualizações de tela e o calculo automático.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.Visible = False
    
    For i = 1 To NWs
                
        For Each R In Worksheets(i).UsedRange
            
            If R.Font.Color = 32768 Then
                R.Value = Empty
            End If
        
        Next R
    
    Next i
    
   'Volta a ativar.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Visible = True
    
End Sub

Teste e de retorno.

Boa noite Bruno !

Realmente funcionou para todas as abas, mas a questão que eu perguntei desde o começo, era o código funcionar pra cada aba individualmente, sendo o mesmo código entendeu ? Porque dependendo da minha rotina, eu não vou querer apagar todos os dados da planilha inteira. Varia pra cada mes. É possivel ?

 
Postado : 08/02/2017 8:31 pm
brunoxro
(@brunoxro)
Posts: 698
Honorable Member
 

Boa tarde Matheus,

Tem alguns pontos que preciso entender melhor.
Se você quer apagar cada aba(planilha) individualmente, você pode colocar o primeiro código que postei em cada botão de deletar em cada planilha.
Você pode especificar quais planilhas(abas) deve ser delatar, colocando um rotina de repetição que diga quais as planilhas não/ou devem ter as células com a cor verde deletadas.
Se você quiser deletar parcialmente os valores de uma planilha(aba), você vai ter que colocar outro critério além da cor verde. Alguns células com a cor verde você não vai querer deletar?

Nesse seu exemplo, qual o resultando final você deseja?

att,

 
Postado : 09/02/2017 1:18 pm
(@guimatheus)
Posts: 30
Eminent Member
Topic starter
 

Boa tarde Matheus,

Tem alguns pontos que preciso entender melhor.
Se você quer apagar cada aba(planilha) individualmente, você pode colocar o primeiro código que postei em cada botão de deletar em cada planilha.
Você pode especificar quais planilhas(abas) deve ser delatar, colocando um rotina de repetição que diga quais as planilhas não/ou devem ter as células com a cor verde deletadas.
Se você quiser deletar parcialmente os valores de uma planilha(aba), você vai ter que colocar outro critério além da cor verde. Alguns células com a cor verde você não vai querer deletar?

Nesse seu exemplo, qual o resultando final você deseja?

att,

Boa tarde Bruno,

É isso o que disse na primeira hipótese, eu quero apagar TODOS os dados que contém aquela cor naquela página, porque o resto eu já pintei de outra cor para não ser apagado entendeu ? Por isso eu não queria colocar mais critérios.

Eu usei seu código nas outras abas, mas deu erro. Ele só apagou as duas primeiras abas, o restante não funcionou. Por isso voltei aqui pra ver se podia me ajudar...

 
Postado : 09/02/2017 1:29 pm
brunoxro
(@brunoxro)
Posts: 698
Honorable Member
 

Boa tarde Matheus,

Como você deseja é a hipótese 1 que falei, acho que o erro acontece em relação a selecionar a planilha.
Uma solução que pode ser trabalhosa mas só se faz uma vez é ir copiando e colando as Sub (não esqueça de mudar o nome da Sub) e mudar o nome da planilha no código.

Nesse código você apenas tem que mudar o nome da planilha, sem se preocupar em selecionar a área de busca. Porque está usando o UsedRange.

Sub ApagarValores()

    Dim R   As Range
    Dim Ws  As Worksheet
    
    'Mude aqui o nome da planilha
    Set Ws = Sheets("BPI")
    
    'Desabilita as atualizações de tela e o calculo automático.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.Visible = False
    
    'Vai buscar em todas as células preenchidas dessa planilha.
    For Each R In Ws.UsedRange
        
        If R.Font.Color = 32768 Then
            R.Value = Empty
        End If
    
    Next R
    
   'Volta a ativar.
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.Visible = True
    
End Sub

Você no módulo 1 da um Ctrl+C e Ctrl+V, muda o nome da Sub e coloca o nome da planilha. Depois você manda rodar ou coloca no botão da planilha especificada.

Teste e de retorno.

att,

 
Postado : 09/02/2017 1:45 pm