Filtrar tabela dinâmica com VBA [RESOLVIDO]

[Fabricio_Tavares]

Boa tarde,

Preciso filtrar duas tabelas dinâmicas conforme informações de uma outra aba.

Na planilha em anexo, tem 3 abas. Relatórios - Entradas - Saídas

Na aba relatórios, tem os campos para selecionar "Entrada ou Saída", "Cliente", "Data Inicial" e "Data Final"

Preciso de um código VBA que filtre automaticamente as tabelas ao clicar no botão OK.

Quando selecionado Entrada, devem ser filtrados o nome do cliente selecionado entre as datas inicial e final na tabela Entrada.

Quando selecionado Saída, devem ser filtrados o nome do cliente selecionado entre as datas inicial e final na tabela Saídas.


O resultado do filtro pode ser mostrado na mesma tabela ou copiado para uma outra aba, pois após este filtro, este relatório será impresso e o filtro desfeito.

[Mikel Silveira Fraga]

Fabrício, boa tarde.

Cara, achei muito interessante sua dúvida e resolvi dar uma olhada.

Seguindo sugestões de alguns sites estrangeiros e o ajuda do Excel, consegui desenvolver uma solução para seu caso, porém esta funcionando parcialmente. Segue código que deve ser inserido em um Módulo:

Código: Selecionar todos

Sub ReportFilter()
  'Declara objeto loTable e wsParam.
  Dim loTable As ListObject
  Dim wsParam As Worksheet
  With ActiveSheet
    'Verifica se foi selecionado um destino para filtro.
    If .Cells(8, 9).Value = "" Or .Cells(10, 9).Value = "" Then
      MsgBox "Favor selecionar movimentação e origem do relatório.", vbExclamation, "Aviso"
      GoTo endReport
    End If
    'Verifica se as datas de inicio/fim foram informadas.
    If .Cells(12, 9).Value = "" Or .Cells(14, 9).Value = "" Then
      MsgBox "Favor informar as datas corretas de início e fim para filtro.", vbExclamation, "Aviso"
      GoTo endReport
    End If
    'Cria o objeto loTable, que receberá a
    'tabela dinâmica, conforme seleção do filtro.
    If .Cells(8, 9).Value = "Entrada" Then
      Set wsParam = Sheets("Entradas (Q)")
      Set loTable = wsParam.ListObjects("Entradas")
    Else
      Set wsParam = Sheets("Saídas (W)")
      Set loTable = wsParam.ListObjects("Saídas")
    End If
  End With
  'Declara variável e armazena código do cliente.
  Dim codCliente As Integer
  'Usa a função Match (Corresp) em VBA, para capturar a linha em que
  'se localiza o código correspondente da origem/destino informada.
  codCliente = Sheets("Clientes (T)").Cells(Application.WorksheetFunction.Match( _
                  ActiveSheet.Cells(10, 9), Sheets("Clientes (T)").Columns(2), 0), 1).Value
  'Inicia bloco de filtragem.
  With loTable.Range
    'Limpa o filtro existente.
    .AutoFilter 1: .AutoFilter 2
    'Realiza filtro pela coluna Data.
    .AutoFilter 1, ">=" & ActiveSheet.Cells(12, 9).Value, xlAnd, _
                   "<=" & ActiveSheet.Cells(14, 9).Value, True
    'Realiza filtro pela coluna codCliente.
    .AutoFilter 2, codCliente
  End With
  wsParam.Select
endReport:
  'Limpa relatório.
  Set loTable = Nothing
  Set wsParam = Nothing
End Sub

Um dos sites de referencia foi um artigo da Microsoft chamado: Sorting and Filtering a Table with the List Object in Excel 2010.

Na parte de se realizar o filtro pela data é onde existe algum erro de informação. Em relação ao código, parece estar correto, o que me faz acreditar que o problema seja o tipo de dado dos valores carregados para realização do filtro. Mas não consegui identificar.

Estou deixando o código aqui, para que demais amigos possam dar uma olhada e sugerir alguma alteração sobre os valores datas, para conclusão do filtro.

Espero que esse código já seja um caminho para a solução do mesmo.

Abraços e excelente semana.

[Fabricio_Tavares]

Bom dia Mikel,

Apanhei bastante e pesquisei também. Consegui montar um código que atendeu bem ao que eu estava precisando:

Sub Relatórios_OK()

If Worksheets("Relatórios").Range("I8") = "" Then
MsgBox "A movimentação é um campo obrigatório. Retorne e preencha corretamente."
Exit Sub
End If

If Worksheets("Relatórios").Range("I10") = "" Then
MsgBox "A unidade de origem/destino é um campo obrigatório. Retorne e preencha corretamente."
Exit Sub
End If

If Worksheets("Relatórios").Range("I12") = "" Then
MsgBox "A data inicial é um campo obrigatório. Retorne e preencha corretamente."
Exit Sub
End If

If Worksheets("Relatórios").Range("I14") = "" Then
MsgBox "A data final é um campo obrigatório. Retorne e preencha corretamente."
Exit Sub
End If

Dim datei As Double
Dim datef As Double

datei = Sheets("Relatórios").Range("I12").Value
datef = Sheets("Relatórios").Range("I14").Value

If Worksheets("Relatórios").Range("I8") = "Entrada" Then
Sheets("Entradas (Q)").Select
ActiveWindow.DisplayHeadings = False
Range("Entradas[Data]").Select
Selection.NumberFormat = "m/d/yyyy"
ActiveSheet.ListObjects("Entradas").Range.AutoFilter Field:=3, Criteria1:=Range("F3").Value
ActiveSheet.ListObjects("Entradas").Range.AutoFilter Field:=1, _
Criteria1:=">= " & datei, Operator:=xlAnd, Criteria2:="<=" & datef
Columns("A:C").Select
Selection.EntireColumn.Hidden = True
Columns("H:K").Select
Selection.EntireColumn.Hidden = True

ActiveSheet.Protect
ActiveSheet.EnableSelection = xlUnlockedCells

End If

If Worksheets("Relatórios").Range("I8") = "Saída" Then
Sheets("Saídas (W)").Select
ActiveWindow.DisplayHeadings = False
Range("Saídas[Data]").Select
Selection.NumberFormat = "m/d/yyyy"
ActiveSheet.ListObjects("Saídas").Range.AutoFilter Field:=3, Criteria1:=Range("F3").Value
ActiveSheet.ListObjects("Saídas").Range.AutoFilter Field:=1, _
Criteria1:=">= " & datei, Operator:=xlAnd, Criteria2:="<=" & datef
Columns("A:C").Select
Selection.EntireColumn.Hidden = True
Columns("H:O").Select
Selection.EntireColumn.Hidden = True

ActiveSheet.Protect
ActiveSheet.EnableSelection = xlUnlockedCells

End If

End Sub

Obrigado pela ajuda!

[Mikel Silveira Fraga]

Fabrício Tavares, bom dia.

Excelente. Inclusive detectei onde estava a minha falha para o filtro da data. Nas planilhas, as datas são armazenadas com "mmddyyyy" e, como eu não estava forçando essa formatação, o filtro estava sendo realizado com a data incorreta.

Meus parabéns pelo resultado.