Seguem alguns exemplos de programação VBA para manipular o AutoFiltro do MS Excel, para uso com as listas de dados encontrados nas tabelas das nossas planilhas.
Quando nomeamos estas tabelas de dados constituimos um ListObject, o qual automaticamente recebe a sua própria propriedade AutoFiltro.
Mostrando todos os registros
O código abaixo mostra todos os registros duma lista na planilha ativa, onde um filtro foi aplicado.
Sub ShowAllRecordsList1()
' Mostra todos os registros
Dim Lst As ListObject
Set Lst = ActiveSheet.ListObjects(1)
If Lst.AutoFilter.FilterMode Then
Lst.AutoFilter.ShowAllData
End If
End Sub
Ligando o AutoFiltro da nossa Lista
Ao usar o código a seguir, você ligará o AutoFiltro do Excel na 1ª lista da planilha ativa.Sub TurnAutoFilterOnList1()
' Liga o AutoFiltro na 1ª lista.
Dim Lst As ListObject
Set Lst = ActiveSheet.ListObjects (1)
Let Lst.ShowAutoFilter = True
End Sub
Desligando a Lista de AutoFiltro
Utilize o código a seguir para desligar um AutoFiltro do Excel na 1ª lista da planilha ativa.Sub TurnAutoFilterOffList1()
' Desliga o AutoFiltro na 1ª lista.Dim Lst As ListObjectSet Lst = ActiveSheet.ListObjects(1)Let Lst.ShowAutoFilter = False
End Sub
Contando as Listas de AutoFiltros
Para contar todas as listas e tabelas nomeadas duma planilha, onde existem AutoFiltros ativos, usamos o código a seguir.
Sub CountListAutoFilters()
' Conta a Lista de AutoFiltros mesmo que todas as seta fiquem escondidas.
Dim Lst As ListObject
Dim i As Long
Let i = 0
For Each Lst In ActiveSheet.ListObjects
If Lst.ShowAutoFilter = True Then
Let i = i + 1
End If
Next Lst
Debug.Print "Lista de autofiltros: " & i
End Sub
Ocultando todas as Setas da lista de AutoFiltro, exceto umaTalvez deseje que os seus usuários filtrem apenas uma das colunas da sua primeira Lista. O procedimento VBA a seguir, esconde as setas de todas as colunas, exceto a segunda coluna da 1ª lista.
Sub HideArrowsList1()
'hides all arrows except list 1 column 2Dim Lst As ListObjectDim c As RangeDim i As IntegerLet Application.ScreenUpdating = FalseSet Lst = ActiveSheet.ListObjects(1)
Let i = 1For Each c In Lst.HeaderRowRange
If i <> 2 ThenLst.Range.AutoFilter Field:=i, _VisibleDropDown:=FalseElseLst.Range.AutoFilter Field:=i, _VisibleDropDown:=TrueEnd IfLet i = i + 1
NextLet Application.ScreenUpdating = True
End Sub
Ocultando Setas específicas nas listas de AutoFiltroTalvez, em alguns casos específicos, queiramos ocultar as setas de colunas específicas na nossa lista de dados, deixando as demais setas visíveis. O código a seguir esconde as setas das colunas 1, 3 e 4 na 2ª lista.
Sub HideSpecifiedArrowsList2()' Esconde setas (arrows) em colunas específicas na 2ª lista.Dim Lst As ListObjectDim c As RangeDim i As IntegerLet Application.ScreenUpdating = FalseSet Lst = ActiveSheet.ListObjects(2)Let i = 1For Each c In Lst.HeaderRowRange
Select Case i
Case 1, 3, 4
Lst.Range.AutoFilter Field:=i, _
Visibledropdown:=False
Case Else
Lst.Range.AutoFilter Field:=i, _
Visibledropdown:=True
End Select
Let i = i + 1
NextLet Application.ScreenUpdating = TrueEndSub
Visualizar todas as setas da Lista AutoFiltroPara mostrar todas as setas da 1ª Lista, podemos usar o código a seguir:
Sub ShowArrowsList1()
Dim Lst As ListObject
Dim c As Range
Dim i As Integer
Let Application.ScreenUpdating = False
Set Lst = ActiveSheet.ListObjects(1)
Let i = 1
For Each c In Lst.HeaderRowRange
Lst.Range.AutoFilter Field:=i, _
Visibledropdown:=True
Let i = i + 1
Next
Let Application.ScreenUpdating = True
End Sub
Copiando Linhas filtradas específicas, sem os títulosEste simples código copia somente as linhas filtradas, mas não os respectivos títulos.A cópia é feita a partir da 1ª Lista na planilha ativa, para uma nova planilha.
Sub CopyFilteredRowsOnlyList1()Dim wsL As WorksheetDim ws As WorksheetDim rng As RangeDim rng2 As RangeDim Lst As ListObjectLet Application.ScreenUpdating = FalseSet wsL = ActiveSheetSet Lst = wsL.ListObjects(1)With Lst.AutoFilter.Range
On Error Resume Next
Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End WithIf rng2 Is Nothing ThenMsgBox "Sem dados para copiar."ElseSet ws = Sheets.AddSet rng = Lst.AutoFilter.Range' Copia todas as linhas sem os cabeçalhosrng.Offset(1, 0).Resize(rng.Rows.Count - 1) _.SpecialCells(xlCellTypeVisible).Copy _Destination:=ws.Range("A1")End IfLet Application.ScreenUpdating = TrueEnd Sub
Copiando Linhas filtradas específicas, com os títulosO código abaixo copia as linhas filtradas, e as suas respectivas posições, com os títulos.
Sub CopyFilteredRowsAndHeadingsList1()
Dim wsL As WorksheetDim ws As WorksheetDim rng As RangeDim rng2 As RangeDim Lst As ListObjectLet Application.ScreenUpdating = FalseSet wsL = ActiveSheetSet Lst = wsL.ListObjects(1)With Lst.AutoFilter.Range
On Error Resume NextSet rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _.SpecialCells(xlCellTypeVisible)On Error GoTo 0
End WithIf rng2 Is Nothing ThenMsgBox "Sem dados para copiar."ElseSet ws = Sheets.AddSet rng = Lst.AutoFilter.Range' Copia as Linhas com os seus cabeçalhos.rng.SpecialCells(xlCellTypeVisible).Copy _Destination:=ws.Range("A1")End IfLet Application.ScreenUpdating = True
End Sub
Conte as Linhas da Lista Visível
Com o exemplo do código a seguir, exibiremos uma mensagem que mostra quantas linhas estão visíveis após a aplicação do filtro:
Sub CountVisibleRowsList1()
Dim Lst As ListObjectDim rng As RangeSet Lst = ActiveSheet.ListObjects(1)Set rng = Lst.AutoFilter.RangeMsgBox rng.Columns(1). _SpecialCells(xlCellTypeVisible).Count - 1 _& " of " & rng _.Rows.Count - 1 & " Registros"
End Sub
Tags: VBA, Excel, List, AutoFilter, autofiltro, funções, autofiltro, listobject, Worksheet ,
Nenhum comentário:
Postar um comentário