2

Private Sub PreencheLista().. Desta publicação aqui Filtrar tabela dinâmica por palavra em uma célula

... É muito eficiente em fazer as buscas da coluna A ....

Gostaria de pegar os valores que estão na Listbox e aplicar eles como filtros na TD ...

(Ativo opção Multiselect) e seleciono na ListBox dentre as opções que apareceram quais eu quero que aplique o filtro da TD.

OU... Pegar todos os resultados e aplicar eles no filtro da TD...

Está assim..

Private Sub TextBox1_Change()
textoDigitado = Range("$C$18").Text
Call PreencheLista
End Sub

Private Sub PreencheLista()
textoDigitado = TextBox1.Text
'código que irá filtrar os nomes
Dim linha As Integer
Dim TextoCelula As String
linha = 1
'limpa os dados do formulário
ListBox1.Clear
'Irá executar até o último nome
While ActiveSheet.Cells(linha, 1).Value <> Empty
'pega o nome atual
TextoCelula = ActiveSheet.Cells(linha, 1).Value
'quebra a palavra atual pela esquerda conforme a quantidade de letras digitadas e compara com o texto digitado
If InStr(UCase(TextoCelula), UCase(textoDigitado)) > 0 Then
'se a comparação for igual será adicionado no formulario
ListBox1.AddItem ActiveSheet.Cells(linha, 1)
End If
linha = linha + 1
Wend
End Sub

inserir a descrição da imagem aqui

2

1 Resposta 1

1

Filtro Avançado

É possível realizar um filtro avançado com o código do Ralph do SOen, tirar o acento da palavra com o código do ExtendOffice e ignorar minúscula ou maiúscula transformando tupo em maiúscula com Ucase()

O filtro é realizado num formulário de nome Userform1, uma caixa de texto de nome TextBox1 e uma lista de nome ListBox1.

Formulário

Código

Private Sub Textbox1_Change()
    'https://stackoverflow.com/a/42880069/7690982
    Dim i As Long
    Dim arrList As Variant
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Nome da Planilha")

    Me.ListBox1.Clear
    If ws.Range("A" & ws.Rows.Count).End(xlUp).Row > 1 And Trim(Me.TextBox1.Value) <> vbNullString Then
        arrList = ws.Range("A1:A" & ws.Range("A" & ws.Rows.Count).End(xlUp).Row).Value2
        For i = LBound(arrList) To UBound(arrList)
            If InStr(1, UCase(StripAccent(CStr(arrList(i, 1)))), UCase(StripAccent(Trim(Me.TextBox1.Value))), vbTextCompare) Then
                Me.ListBox1.AddItem arrList(i, 1)
            End If
        Next i
    End If
    If Me.ListBox1.ListCount = 1 Then Me.ListBox1.Selected(0) = True

End Sub

Public Function StripAccent(thestring As String)
    'https://www.extendoffice.com/documents/excel/707-excel-replace-accented-characters.html
    Dim A As String * 1
    Dim B As String * 1
    Dim i As Integer
    Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
    Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
    For i = 1 To Len(AccChars)
        A = Mid(AccChars, i, 1)
        B = Mid(RegChars, i, 1)
        thestring = Replace(thestring, A, B)
    Next
    StripAccent = thestring
End Function

Resultado

A letra é digitada no TextBox1 e o filtro é realizado, como é mostrado abaixo:

Resultado a

Resultado andre

EDIT:

Multiselect

Há três opções de Multiselect:

  • ListBox.MultiSelect = 1: Selecionar somente um elemento.
  • ListBox.MultiSelect = 2: Clicar no item ou pressionar a barra de espaço para selecionar múltiplos itens
  • ListBox.MultiSelect = 3: Pressione Shift e Ctrl para selecionar múltiplos itens

Código

Então o seguinte código é utilizado para alterar as configurações de setup ao iniciar o formulário.

Private Sub UserForm_Initialize()
    'Entre outros códigos de inicialização
    Me.ListBox1.MultiSelect = 1
End Sub

Botão de Filtrar Tabela Dinâmica

Um botão CommandButton pode ser adicionado e após os dados serem escolhidos, estes serão filtrados na Tabela Dinâmica.

Código

A Função IsInArray() do JimmyPena do SOen é utilizada.

Private Sub CommandButton1_Click()
    Dim i As Long, j As Long
    Dim PvtTbl      As PivotTable
    Dim PvtItm      As PivotItem
    Dim ws As Worksheet
    Dim arr() As Variant
    On Error GoTo Sair
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    Set ws = ThisWorkbook.Sheets("Nome da Planilha")
    Set PvtTbl = ws.PivotTables("Tabela dinâmica1")
    PvtTbl.ManualUpdate = True
    For i = 0 To ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) = True Then
            ReDim Preserve arr(j)
            arr(j) = Me.ListBox1.List(i)
            j = j + 1
        End If
    Next i

    With PvtTbl.PivotFields("campo")
        .ClearAllFilters
        For Each PvtItm In .PivotItems
            If IsInArray(PvtItm.Name, arr) = True Then
                PvtItm.Visible = True
            Else
                PvtItm.Visible = False
            End If
        Next PvtItm
    End With

Sair:
    Set PvtTbl = ws.PivotTables("Tabela dinâmica1")
    PvtTbl.ManualUpdate = False
    Debug.Print Err.Description
    On Error GoTo 0
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
'https://stackoverflow.com/a/10952705/7690982
  IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
9
  • Os resultados que surgirem na Listbox podem ser aplicados como filtros na tabela dinâmica? Cada resultado na Llistbox é uma item específico da Field.. correto ? todos ou até escolher na Listbox.. Selecionando manualmente (multiselect) na lista ou aplicando todos os possíveis resultados a medida que forem surgindo da lista para o filtro da TD. 24/06/2018 às 22:22
  • @AndréMachado Veja o edit 25/06/2018 às 13:02
  • desculpa pela demora no retorno.. Surgiram outros projetos nesse meio tempo.. mas quero muito te agradecer. Seu empenho em solucionar as falhas no meu projeto ... Trouxeram fluidez para as rotinas no modelo acima. Resultado esplêndido. 3/07/2018 às 4:47
  • Boa tarde @ danieltakeshi .. Se possível.... Tive uma dúvida recente sobre este método... como referencio com uma tabela dinâmica gerado pelo Power Pivot ... Exemplo: ActiveSheet.PivotTables("Tabela dinâmica2").PivotFields( _ "[Tabela2].[Nomes 2].[Nomes 2]").VisibleItemsList = Array( _ "[Tabela2].[Nomes 2].&[Helena]")... Ela se referencia de modo diferente... Tendei trocar o rótulo por PivotFields("[Tabela2].[Nomes 2].[Nomes 2]").. mas o código não executa ... Código Botão de Filtrar Tabela Dinâmica (editado por você). Se possível é claro. 7/08/2018 às 18:55
  • @ danieltakeshi Segue Questão elaborada. pt.stackoverflow.com/q/320733/116347 Agradeço desde já. 8/08/2018 às 16:15

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .