VBA – Obtendo os valores dos filtros aplicados numa planilha

AutoFiltro

Mais uma pra lista dos canivetes suíços. O autofiltro é um mecanismo tão conhecido e utilizado que poucos notam um defeito (pelo menos em minha opinião é um defeito).

Supondo que você tenha uma tabela com 20 colunas. Você filtra uma coluna, duas, três…. quando chega no resultado que quer, já nem lembra mais quais os filtros selecionou. O que é normalmente feito é, limpa-se os filtros e começa tudo de novo.

Foi um cliente (sempre eles, mas eu gosto!) que gerou a necessidade. Portanto, foi preciso uma forma de extrair quais os filtros estavam sendo aplicados na planilha naquele momento. Uma garimpada na internet e lá veio uma resposta.

Adaptei o código abaixo para atender às necessidades da maioria e corrigir alguns erros. Mantive o nome da função original para garantir a autoria do código

Public Function GetAutoFilterCriteria() As String
On Error GoTo trataerro
    Dim oAF As AutoFilter
    Dim oFlt As Filter
    Dim sField As String
    Dim sCrit1 As String
    Dim sCrit2 As String
    Dim sMsg As String
    Dim i As Integer
 
    ' Verifica se há filtros ativados na planilha
    If Not ActiveSheet.AutoFilterMode And Not ActiveSheet.ListObjects(1).ShowAutoFilter Then
        sMsg = "O auto filtro não está ativado"
        GoTo trataerro
    Else
        If ActiveSheet.AutoFilterMode Then
            ' obtém o objeto de filtro da planilha
                Set oAF = ActiveSheet.AutoFilter
        Else
            ' obtém o objeto de filtro da planilha
            Set oAF = ActiveSheet.ListObjects(1).AutoFilter
        End If
    End If
 
    ' itera em todos os filtros aplicados na planilha
    For i = 1 To oAF.Filters.Count
        ' obtém no nome da coluna
        sField = oAF.Range.Cells(1, i).Value
 
        ' obtém o objeto filtro da coluna
        Set oFlt = oAF.Filters(i)
 
        ' Está ativo?
        If oFlt.On Then
 
            ' Obtém o primeiro critério de filtro (tem que haver ao menos um)
            If IsArray(oFlt.Criteria1) Then
                Dim x As Integer
                sMsg = sMsg & vbCrLf & sField
                For x = 1 To UBound(oFlt.Criteria1)
                    sMsg = sMsg & "'" & oFlt.Criteria1(x) & "'"
                Next x
            Else
                sMsg = sMsg & vbCrLf & sField & "'" & oFlt.Criteria1 & "'"
            End If
 
            ' Verifica se há operador aplicado. Caso positivo, analisa o critério seguinte
            Select Case oFlt.Operator
                Case xlAnd
                    sMsg = sMsg & " E " & sField & "'" & oFlt.Criteria2 & "'"
                Case xlOr
                    sMsg = sMsg & " Ou " & sField & "'" & oFlt.Criteria2 & "'"
                Case xlBottom10Items
                    sMsg = sMsg & " (últimos 10 itens)"
                Case xlBottom10Percent
                    sMsg = sMsg & " (últimos 10%)"
                Case xlTop10Items
                    sMsg = sMsg & " (primeiros 10 itens)"
                Case xlTop10Percent
                    sMsg = sMsg & " (primeiros 10%)"
            End Select
        End If
 
    Next i
 
    If sMsg = "" Then
        ' Mensagem vazia, signifca que não há filtros aplicados
        sMsg = "Não há filtros ativados"
        Else
        ' Do contrário, monta a mensagem
        sMsg = "Filtros aplicados: " & Left(sMsg, Len(sMsg) - 1)
    End If
 
trataerro:
    If Err.Description <> "" Then
        Debug.Print Err.Description
        GetAutoFilterCriteria = "Não foi possível analisar os filtros"
    Else
        ' Display the message
        GetAutoFilterCriteria = sMsg
    End If
End Function

A função não é infalível, mas funcionou muito bem nos casos em que testei. A planilha abaixo mostra a função em trabalhando:

AutoFiltro Trabalhando

AutoFilterMode.zip
VBA – Obtendo os valores dos filtros aplicados numa planilha(20.19 KiB

Link da macro original: http://www.vbaexpress.com/forum/archive/index.php/t-7564.html

Comentários

comentários