Este outro logo abaixo da mesma postagem do link acima ..tem diferença em execução ? ... https://stackoverflow.com/a/43139189/9948374
Existe forma de acelerar a execução de algum destes códigos .. Tipo formato binário ... ou alteração n código mesmo.. ?
Coloquei um botão para executar .. pois com
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Assim que eu coloco a primeira letra ele já começa a executar .. isso deixa a planilha "pesada" ... gostaria se não for com um botão fosse ao dar enter na célula "C18" .. (Ao final de cada palavra buscada).
@danieltakeshi, gostaria que ao apagar a célula.. ("C18") = Empty .. aparecesse no lugar "Faça a busca por endereço aqui".. executasse ClearAllFilters... no caso a célula ("C18") sempre que não tiver busca pra fazer terá "Faça a busca por endereço aqui".
mas o filtro tem se comportado desta forma com o código... seleciona o ultimo item do filtro com buscas de texto que não tem entre as opções.
Está assim..
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
'https://stackoverflow.com/questions/42929493/filter-items-with-certain-text-in-a-pivot-table-using-vba
Dim PvtTbl As PivotTable
Dim PvtItm As PivotItem
Dim f As String
On Error GoTo Sair
With Application
.EnableEvents = False
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
If Target.Address = "$C$18" Then
f = Target.Value
' set the pivot table
Set PvtTbl = PivotTables("Tabela dinâmica9")
PvtTbl.ManualUpdate = True
With PvtTbl.PivotFields("Conteúdo variável 5")
.ClearAllFilters
For Each PvtItm In .PivotItems
If PvtItm.Name Like "*" & f & "*" Then
PvtItm.Visible = True
Else
PvtItm.Visible = False
End If
Next PvtItm
End With
End If
Sair:
Set PvtTbl = PivotTables("Tabela dinâmica9")
PvtTbl.ManualUpdate = False
Debug.Print Err.Number
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Private Sub TextBox1_Change()
textoDigitado = Range("$C$18").Text
Call PreencheLista
End Sub
Private Sub UserForm_Initialize()
'Ao iniciar o formulario ira chamar o procedimento PreencheLista
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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("C18").Value = Empty Then
Range("C18").Value = "Faça a busca por endereço aqui"
Call ClearReportFiltering
Else
End If
End Sub
ClearReportFiltering é .. Macro para .ClearAllfilter na Fileds na TD
(Foi a forma que encontrei por enquanto)
Sheets("Dashboard")
é o nome da Planilha em que está a tabela,PivotTables("PivotTable1")
é o nome da tabela ,PivotFields("TLEG")
nome do campo da tabela,Sheets("Dashboard").Range("Lane1").Value
célula com o valor a ser procuradoWorksheet_Change
está sendo usado.