[VBA] FILTRAR LINHA SELECIONADA COM UM BOTÃO (EXCEL)

Daniel Tadeu Delgado

Daniel Tadeu Delgado Publicado 09/10/2017 


Recentemente, um aluno perguntou sobre a possibilidade de criar um botão (macro) para conseguir filtrar uma tabela com base na célula selecionada. 

Aparentemente, é uma função simples, mas para deixa-la totalmente automatizada, é preciso analisar se há mais de uma tabela na planilha, se a tabela inicia na primeira coluna do Excel, ou se ela está no meio do Excel.

Para isso é preciso utilizar alguns códigos avançados.

Para aplicar o código abaixo basta copiar e colar dentro do seu VBA e atribuir os botões aos códigos abaixo:

OBS: PARA BAIXAR A PLANILHA MODELO, INSCREVA-SE GRATUITAMENTE AQUI

OBS: o código está criado para trabalhar com o objeto TABELA e não com intervalos no Excel. 


Sub FILTRAR_TABELA()

Dim num_coluna_excel As Integer
Dim num_coluna_tabela As Integer
Dim num_coluna As Integer
Dim texto_filtro As String

On Error GoTo erro


'Define as variáveis conforme a célula selecionada

'Identifica o número da coluna no Excel que a tabela Inicia, com base no endereço da tabela
pri_coluna_tabela = Range(ActiveCell.ListObject.Range.Address).Column

'Identifica o número da coluna da célula selecionada
num_coluna_excel = ActiveCell.Column

'Identifica o número da coluna da célula selecionada com base na linha selecionada e a primeira coluna da tabela
'Por exemplo, se a primeira coluna da primeira tabela começa na coluna 10
'e foi selecionada a coluna 10, siginifica que é necessário filtrar a primeira coluna
'então, 10 - 10 vai ser zero, logo precisa adicionar 1 no final para filtrar a primeira coluna
num_coluna = num_coluna_excel - pri_coluna_tabela + 1

'Pega o texto da célula selecionada, uma vez que no filtro precisa sempre informar como texto
texto_filtro = ActiveCell.Text

'Filtra a Tabela Selecionada
ActiveCell.ListObject.Range.AutoFilter Field:=num_coluna, Criteria1:=texto_filtro

Exit Sub
erro:
MsgBox "Selecione uma célula dentro de uma tabela", vbCritical

End Sub


Sub LIMPAR_FILTRO()

On Error Resume Next
ActiveSheet.ShowAllData
End Sub

 

Voltar ao topo