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:
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