Salt la conținutul principal

Cum se filtrează tabelul pivot pe baza unei valori specifice a celulei în Excel?

În mod normal, filtram datele într-un tabel pivot selectând elemente din lista derulantă, așa cum se arată în captura de ecran de mai jos. De fapt, puteți filtra un tabel pivot pe baza valorii dintr-o anumită celulă. Metoda VBA din acest articol vă va ajuta să rezolvați problema.

Filtrează tabelul pivot pe baza unei valori specifice a celulei cu cod VBA

Filtrează tabelul pivot pe baza unei valori specifice a celulei cu cod VBA

Următorul cod VBA vă poate ajuta să filtrați un tabel pivot pe baza unei valori specifice a celulei în Excel. Vă rugăm să faceți următoarele.

1. Vă rugăm să introduceți în avans o valoare pe care să o filtrați pe tabelul pivot într-o celulă (aici selectez celula H6).

2. Deschideți foaia de lucru conține tabelul pivot pe care îl veți filtra după valoarea celulei. Apoi faceți clic dreapta pe fila foi și selectați Vizualizare cod din meniul contextual. Vedeți captura de ecran:

3. În deschidere Microsoft Visual Basic pentru aplicații fereastră, copiați mai jos codul VBA în fereastra Cod.

Cod VBA: Filtru Pivot Tabel pe baza valorii celulei

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xStr As String
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Category")
    xStr = Target.Text
    xPFile.ClearAllFilters
    xPFile.CurrentPage = xStr
    Application.ScreenUpdating = True
End Sub

notițe: În cod,

1) "Sheet1”Este numele fișei de lucru.
2) "Tabel Pivot2”Este numele Tabelului pivot.
3) Câmpul de filtrare din tabelul pivot se numește „Categorii".
4) Valoarea pe care doriți să o filtrați în tabelul pivot este plasată în celulă H6.
Puteți modifica valorile variabilei de mai sus după cum aveți nevoie.

4. apasă pe Alt + Q tastele pentru a închide Microsoft Visual Basic pentru aplicații fereastră.

Apoi, tabelul pivot filtrează pe baza valorii din celula H6, după cum se arată în imaginea de mai jos:

Puteți schimba valoarea celulei cu alte persoane după cum aveți nevoie.

notițe: Valorile pe care le tastați în celula H6 trebuie să se potrivească exact cu valorile din lista derulantă a categoriei din tabelul pivot.

Legate de articole:

Cele mai bune instrumente de productivitate de birou

🤖 Kutools AI Aide: Revoluționați analiza datelor pe baza: Execuție inteligentă   |  Generați codul  |  Creați formule personalizate  |  Analizați datele și generați diagrame  |  Invocați funcțiile Kutools...
Caracteristici populare: Găsiți, evidențiați sau identificați duplicatele   |  Ștergeți rândurile goale   |  Combinați coloane sau celule fără a pierde date   |   Rundă fără Formula ...
Super căutare: VLookup cu mai multe criterii  |   VLookup cu valori multiple  |   VLookup pe mai multe foi   |   Căutare fuzzy ....
Listă derulantă avansată: Creați rapid o listă derulantă   |  Listă drop-down dependentă   |  Listă derulantă cu selectare multiplă ....
Manager de coloane: Adăugați un număr specific de coloane  |  Mutați coloanele  |  Comutați starea vizibilității coloanelor ascunse  |  Comparați intervale și coloane ...
Caracteristici prezentate: Focus pe grilă   |  Vedere de proiectare   |   Big Formula Bar   |  Manager registru de lucru și foi   |  Biblioteca de resurse (Text automat)   |  Data Picker   |  Combinați foi de lucru   |  Criptare/Decriptare celule   |  Trimiteți e-mailuri după listă   |  Super Filtru   |   Filtru special (filtrează bold/italic/barat...) ...
Top 15 seturi de instrumente:  12 Text Instrumente (Adăuga text, Eliminați caractere,...)   |   50+ Diagramă Tipuri de (Gantt Chart,...)   |   40+ Practic Formule (Calculați vârsta pe baza zilei de naștere,...)   |   19 inserare Instrumente (Introduceți codul QR, Inserați imaginea din cale,...)   |   12 Convertire Instrumente (Numere la cuvinte, conversie valutara,...)   |   7 Merge & Split Instrumente (Rânduri combinate avansate, Celule divizate,...)   |   ... și altele

Îmbunătățiți-vă abilitățile Excel cu Kutools pentru Excel și experimentați eficiența ca niciodată. Kutools pentru Excel oferă peste 300 de funcții avansate pentru a crește productivitatea și a economisi timp.  Faceți clic aici pentru a obține funcția de care aveți cea mai mare nevoie...

Descriere

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
Comments (23)
No ratings yet. Be the first to rate!
Ambroise
Ambroise
This comment was minimized by the moderator on the site
Bonjour,

Merci beaucoup pour cette explication qui marche parfaitement.
En revanche, j'aimerais pouvoir utiliser ce code pour pouvoir filtrer deux tableaux croisés dynamiques en même temps qui sont sur la même feuille. La seule petite différence entre les deux, c'est qu'ils n'utilisent pas les mêmes sources. En revanche, le filtre sur lequel se base ces TDC est le même.

Pourriez-vous m'aider à faire évoluer ce code afin que cela fonctionne ?

Voici le code utilisé quand il marche avec un TCD :

Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("G4")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Cadrage").PivotTables("Tableau croisé dynamique7")
Set xPFile = xPTable.PivotFields("N°PROJET")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Merci beaucoup
Reply
0
0
crystal
crystal     Ambroise
This comment was minimized by the moderator on the site
Hi Ambroise,

Sorry it's hard to amend this code to meet your needs. If you want to filter multiple pivot tables with a single filter, the methods in this article below may do you a favor:
How to connect a single slicer to multiple pivot tables in Excel?
Reply
Report
0
0
Ambroise
Ambroise
This comment was minimized by the moderator on the site
Bonjour,
Merci beaucoup pour ces explications.

J'aimerai utiliser un filtre (1 cellule) en F4 par exemple qui filtrerait deux TCD qui sont sur la même feuille.

Cela fonctionne très bien avec un TCD mais dès que j'essaye de combiner le second, ça ne marche pas.
Pourriez-vous m'aider ?

Merci beaucoup
Ambroise
Reply
0
0
DK
DK
This comment was minimized by the moderator on the site
How does it work with Power Pivot, when using multiple tables? I recorded macro changing the value in filter. Made few changes to make the above code work. But it throws Type mismatch error. No matter what I do.
Reply
0
0
crystal
crystal     DK
This comment was minimized by the moderator on the site
Hi DK,
The method does not work for Power Pivot. Sorry for the inconvenience.
Reply
Report
0
0
Lance
Lance
This comment was minimized by the moderator on the site
Thank you so much for this code! I got it working after adjusting to meet my fields, but after formatting some changes on my sheet now it doesn't work! I moved it from A1 to B1, changed some cell formatting to make it stand out, etc. Nothing too crazy but now it doesn't update when I change text in B1. Anyone have any ideas?

Private Sub Worksheet_Change(ByVal Target As Range)
'test
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String

Dim x2PTable As PivotTable
Dim x2PFile As PivotField
Dim x2Str As String

Dim x3PTable As PivotTable
Dim x3PFile As PivotField
Dim x3Str As String

On Error Resume Next
If Intersect(Target, Range("b1")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'tbl-1
Set xPTable = Worksheets("Line Report").PivotTables("PivotTable7")
Set xPFile = xPTable.PivotFields("Utopia Source")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr

'tbl-2
Set x2PTable = Worksheets("Line Report").PivotTables("PivotTable2")
Set x2PFile = x2PTable.PivotFields("Utopia Source")
x2Str = Target.Text
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str

'tbl-3
Set x3PTable = Worksheets("Line Report").PivotTables("PivotTable3")
Set x3PFile = x3PTable.PivotFields("Utopia Source")
x3Str = Target.Text
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str

Application.ScreenUpdating = True

End Sub
Reply
0
0
crystal
crystal     Lance
This comment was minimized by the moderator on the site
Hi Lance,
I tested your code and it works fine in my case. Changing the cell format does not affect the operation of the code.
Reply
Report
0
0
Alex
Alex
This comment was minimized by the moderator on the site
Hello!

I am new with VBA and I would like to have a code to select a pivot filter based on a cell range.
How can I change "CurrentPage" to be a range value ?
Thank you!!
-------------------------------------------------------------------------------------------
Sub PrintTour()

ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bereich 1].[Tour].[Tour ]"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
"[Bereich 1].[Tour].[Tour]"). _
CurrentPage = "[Bereich 1].[Tour lt. Anlieferungstag].&[4001-01]"
End Sub
Reply
0
0
Oksana
Oksana
This comment was minimized by the moderator on the site
What if i want to link the selection cell to a different tab? This is my code so far
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xPTable1 As PivotTable
Dim xPFile1 As PivotField
Dim xStr1 As String
On Error Resume Next
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable1 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable1")
Set xPFile1 = xPTable1.PivotFields("Geography")
xStr1 = Target.Text
xPFile1.ClearAllFilters
xPFile1.CurrentPage = xStr1
Application.ScreenUpdating = True

Dim xPTable2 As PivotTable
Dim xPFile2 As PivotField
Dim xStr2 As String
On Error Resume Next
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable2 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable4")
Set xPFile2 = xPTable2.PivotFields("Geography")
xStr2 = Target.Text
xPFile2.ClearAllFilters
xPFile2.CurrentPage = xStr2
Application.ScreenUpdating = True

Dim xPTable3 As PivotTable
Dim xPFile3 As PivotField
Dim xStr3 As String
On Error Resume Next
If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable3 = Worksheets("SM_SKU PIVOTS").PivotTables("PivotTable8")
Set xPFile3 = xPTable3.PivotFields("Geography")
xStr3 = Target.Text
xPFile3.ClearAllFilters
xPFile3.CurrentPage = xStr3
Application.ScreenUpdating = True

End Sub
Reply
0
0
Fernando
Fernando
This comment was minimized by the moderator on the site
Olá, gostaria de saber se quisesse filtrar mais de uma categoria como poderia ser?
Reply
0
0
sdas34
sdas34
This comment was minimized by the moderator on the site
I would like to use multiple Worksheet Change code in same worksheet. How to do that? My code is as below:
Private Sub Worksheet_Change(ByVal Target As Range)
'Pivot table filter based on cell value
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("D20:D21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Designation")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change2(ByVal Target As Range)
'Pivot table filter based on cell value 2
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
On Error Resume Next
If Intersect(Target, Range("H20:H21")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
Set xPFile = xPTable.PivotFields("Offering")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub
Reply
Report
0
0
Drew
Drew
This comment was minimized by the moderator on the site
Is this possible with google sheets? If so, how?
Reply
0
0
Vibhor
Vibhor     Drew
This comment was minimized by the moderator on the site
Google Sheets will not require any pivot table. you can directly perform through Filter Function
Reply
0
0
AKTaylor
AKTaylor
This comment was minimized by the moderator on the site
I was able to modify/filter 3 different pivots which are on the same tab. I also added a row in my data set "No Data Found", otherwise it left the filter to "ALL" which I didn't want. The above was a great help to earn me Kudos with management so I wanted to share. Note the (All) is case sensitive took me a bit to figure that out.
Private Sub Worksheet_Change(ByVal Target As Range)
'test
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String

Dim x2PTable As PivotTable
Dim x2PFile As PivotField
Dim x2Str As String

Dim x3PTable As PivotTable
Dim x3PFile As PivotField
Dim x3Str As String

On Error Resume Next
If Intersect(Target, Range("a2:e2")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False

'tbl-1
Set xPTable = Worksheets("Graphical").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("MR Department - Department")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
If xPFile.CurrentPage = "(All)" Then xPFile.CurrentPage = "No Data Found"

'tbl-2
Set x2PTable = Worksheets("Graphical").PivotTables("PivotTable2")
Set x2PFile = x2PTable.PivotFields("MR Department - Department")
x2Str = Target.Text
x2PFile.ClearAllFilters
x2PFile.CurrentPage = x2Str
If x2PFile.CurrentPage = "(All)" Then x2PFile.CurrentPage = "No Data Found"

'tbl-3
Set x3PTable = Worksheets("Graphical").PivotTables("PivotTable3")
Set x3PFile = x3PTable.PivotFields("MR Department - Department")
x3Str = Target.Text
x3PFile.ClearAllFilters
x3PFile.CurrentPage = x3Str
If x3PFile.CurrentPage = "(All)" Then x3PFile.CurrentPage = "No Data Found"

Application.ScreenUpdating = True

End Sub
Reply
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations