Note: The other languages of the website are Google-translated. Back to English

Cum se leagă filtrul Tabelului pivot la o anumită celulă din Excel?

Dacă doriți să legați un filtru din tabelul pivot la o anumită celulă și să faceți filtrarea tabelului pivot în funcție de valoarea celulei, metoda din acest articol vă poate ajuta.

Conectați filtrul Tabelului pivot la o anumită celulă cu cod VBA


Conectați filtrul Tabelului pivot la o anumită celulă cu cod VBA

Tabelul pivot pe care îl veți lega funcția de filtrare la o valoare a celulei ar trebui să includă un câmp de filtrare (numele câmpului de filtrare are un rol important în următorul cod VBA).

Luați ca exemplu tabelul pivot de mai jos, se numește câmpul de filtrare din tabelul pivot Categorii, și include două valori „Cheltuieli"Și"Vânzări”. După conectarea filtrului Tabelului pivot la o celulă, valorile celulei pe care le veți aplica pentru a filtra Tabelul pivot ar trebui să fie „Cheltuieli” și „Vânzări”.

1. Vă rugăm să selectați celula (aici selectez celula H6) pe care o veți conecta la funcția de filtrare a tabelului pivot și introduceți una dintre valorile filtrului în celulă în avans.

2. Deschideți foaia de lucru conține tabelul pivot pe care îl veți conecta la celulă. Faceți clic dreapta pe fila foi și selectați Afișați codul din meniul contextual. Vedeți captura de ecran:

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

Cod VBA: conectați filtrul Tabelului pivot la o anumită celulă

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

1) "Sheet1”Este numele foii de lucru deschise.
2) "Tabel Pivot2”Este numele Tabelului pivot, veți lega funcția de filtrare a acestuia la o celulă.
3) Câmpul de filtrare din tabelul pivot se numește „Categorii".
4) Celula la care se face referire este H6. Puteți modifica aceste valori variabile în funcție de nevoile dvs.

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

Acum funcția de filtrare a tabelului pivot este legată de celula H6.

Reîmprospătați celula H6, apoi datele corespunzătoare din tabelul pivot sunt filtrate pe baza valorii existente. Vedeți captura de ecran:

La modificarea valorii celulei, datele filtrate din tabelul pivot vor fi modificate automat. Vedeți captura de ecran:


Selectați cu ușurință rânduri întregi pe baza valorii celulei dintr-o coloană certiană:

Selectați celule specifice utilitatea Kutools pentru Excel vă poate ajuta să selectați rapid rânduri întregi pe baza valorii celulei într-o coloană certiană în Excel, după cum se arată în imaginea de mai jos. După ce ați selectat toate rândurile pe baza valorii celulei, le puteți muta sau copia manual într-o locație nouă, după cum aveți nevoie în Excel.
Descărcați și încercați acum! (30- traseu liber de o zi)


Legate de articole:


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

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!
fundul officetab
Comentarii (36)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
cum se face pe câmpuri multiple, deoarece în cod există o singură țintă
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Frank
Îmi pare rău că nu te pot ajuta cu asta.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Ce se întâmplă dacă celula care este legată de tabelul pivot, în acest caz H6, se află pe altă foaie de lucru? Cum se schimba codul?
Acest comentariu a fost redus la minimum de moderatorul de pe site
ce se întâmplă dacă am mai mult de 1 tabel pivot și să fac legătura la 1 celulă. Cum ar trebui să modific codul?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Jeri,
Îmi pare rău că nu te pot ajuta cu asta. Bine ați venit să postați orice întrebare pe forumul nostru: https://www.extendoffice.com/forum.html pentru a obține mai mult suport Excel din partea profesioniștilor Excel sau alți fani ai Excel.
Acest comentariu a fost redus la minimum de moderatorul de pe site
găsiți-le și modificați-le în Array(), Intersect(), Worksheets(), PivotFields()

Tabel Pivot1
Tabel Pivot2
Tabel Pivot3
Tabel Pivot4
H1
SheetName
Numele domeniului




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Sarpe boa...! Ótima publicação, as faço for use or filter em duas or more tables dinâmicas...? Agradeço desde já.

Buna ziua...! Publicare grozavă, cum folosesc filtrul în două sau mai multe tabele pivot...? Mulțumesc anticipat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Gilmar Alves,
Îmi pare rău că nu te pot ajuta cu asta. Bine ați venit să postați orice întrebare pe forumul nostru: https://www.extendoffice.com/forum.html pentru a obține mai mult suport Excel din partea profesioniștilor Excel sau alți fani ai Excel.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Și-a dat cineva seama de întrebarea legată de tabelele pivot multiple?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Modificați valorile în Array(), Worksheets() și Intersect()



**Găsiți-le și schimbați-le**
SheetName
E1
Tabel Pivot1
Tabel Pivot2
Tabel Pivot3




Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
'Actualizare până la Extendoffice 20180702
Dim xPTable ca PivotTable
Dim xPFile ca PivotField

Dim xPTabled ca tabel pivot
Dim xPFiled ca PivotField

Dim xStr As String



La data de eroare CV următoare

„리스트 만들기
Dim listArray() ca variantă
listArray = Array(„PivotTable1”, „PivotTable2”, „PivotTable3”)



Dacă Intersect(Target, Range("E1")) nu este nimic, atunci ieșiți din sub
Application.ScreenUpdating = Fals

Pentru i = 0 La UBound(listArray)

Set xPTable = Foi de lucru("SheetName").PivotTables(listArray(i))
Setați xPFile = xPTable.PivotFields("Company_ID")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Pagina Următoare →

Application.ScreenUpdating = Adevărat



End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Ciao, sto provando a face lo stesso example per far in modo che il filtrul pivotului și setti sul valore della cella,
non riesco a farla funzionare.

Quale passaggio manca nella descriere sopra?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Ați primit vreo solicitare de eroare? Trebuie să știu mai precis despre problema dvs., cum ar fi versiunea dvs. Excel. Și dacă nu vă deranjează, încercați să vă creați datele într-un registru de lucru nou și încercați din nou, sau faceți o captură de ecran a datelor și încărcați-o aici.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Am încercat să funcționeze pentru filtrul de coloană, dar nu pare să funcționeze. Am nevoie de alt cod pentru asta?

mulțumesc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi Justin,
Ați primit vreo solicitare de eroare? Trebuie să știu mai precis despre problema ta.
Înainte de a aplica codul, nu uitați să modificați „numele foii""numele tabelului pivot""numele filtrului tabelului pivot" si celulă pe care doriți să filtrați tabelul pivot pe baza (vezi imaginea).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Crystal,

Multumesc pentru ajutor. Problema este că funcția nu face nimic dintr-un motiv oarecare. Câteva precizări:

Nume pivot: Order_Comp_B2C
Denumirea foii: Foaie de calcul
Nume filtru: Numărul săptămânii (am schimbat acest nume din ceea ce era „Numărul săptămânii de expediere” în fișierul de date)
Celula de schimbat: O26 și O27 (acesta ar trebui să intre în interval)

În acest pivot, încerc să schimb filtrul pentru coloane, nu am nimic în zona de filtrare din meniul Câmpuri din tabel pivot.

codul meu este:

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
'Actualizare până la Extendoffice 20180702
Dim xPTable ca PivotTable
Dim xPFile ca PivotField
Dim xStr As String
La data de eroare CV următoare
Dacă Intersect(Target, Range("O26")) nu este nimic, atunci ieșiți din sub
Application.ScreenUpdating = Fals
Set xPTable = Foi de lucru(„Foaie de calcul”).PivotTables(„Order_Comp_B2C”)
Setați xPFile = xPTable.PivotFields(„Numărul săptămânii”)
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = Adevărat
End Sub

Multumesc,

Justin
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Justin Teeuw,
Am schimbat Numele pivotului, numele foii, numele filtrului și celula să se schimbe la condițiile pe care le-ați menționat mai sus și a încercat codul VBA pe care l-ați furnizat, funcționează bine în cazul meu. Consultați următorul GIF sau registrul de lucru atașat.
Te superi să creezi un nou registru de lucru și să încerci din nou codul?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Crystal,

Atașată o captură de ecran a pivotului, caseta roșie este filtrul pe care aș dori să-l schimb în funcție de valoarea celulei.

De preferință, aș dori să folosesc o serie de celule care indică numere de mai multe săptămâni.

Multumesc,

Justin
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi Justin,
Îmi pare rău, nu am văzut captura de ecran pe care ați atașat-o pe pagină. Poate există o eroare pe pagină.
Dacă tot trebuie să rezolvați problema, trimiteți-mi un e-mail prin zxm@addin99.com. Îmi pare rău pentru neplăcerile create.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Justin Teeuw,
Vă rugăm să încercați următorul cod VBA. Sper că pot ajuta.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Update by Extendoffice 20220706
    Dim I As Integer
    Dim xFilterStr1, xFilterStr2 As String
    On Error Resume Next
    If Intersect(Target, Range("O26:O27")) Is Nothing Then Exit Sub
    'Application.ScreenUpdating = False
    
    xFilterStr1 = Range("O26").Value
    xFilterStr2 = Range("O27").Value
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        ClearAllFilters
    If xFilterStr1 = "" And xFilterStr2 = "" Then Exit Sub
    ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number"). _
        EnableMultiplePageItems = True
    xCount = ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems.Count

    For I = 1 To xCount
        If I <> xFilterStr1 And I <> xFilterStr2 Then
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = False
        Else
            ActiveSheet.PivotTables("Order_Comp_B2C").PivotFields("Week Number").PivotItems(I).Visible = True
        End If
    Next

    'Application.ScreenUpdating = True
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
L-am folosit pentru un excell normal și a funcționat. Dar nu l-am putut folosi pentru o fișă de lucru olap. poate trebuie sa-l schimb putin?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună maziaritib4 TIB,
Metoda este disponibilă numai pentru Microsoft Excel. Îmi pare rău pentru neplăcerile create.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi Justin,

Acest lucru a funcționat perfect, totuși, mă întreb dacă această regulă poate fi aplicată mai multor tabele pivot din aceeași foaie?

Multumesc,
James
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi James,

Da, acest lucru este posibil, codul pe care l-am folosit pentru aceasta este (4 pivoturi și 2 referințe de celule):

Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
Dim I ca întreg
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 ca șir
La data de eroare CV următoare
Dacă Intersect(Target, Range("O26:P27")) nu este nimic, atunci ieșiți din sub

xFilterStr1 = Interval("O26").Valoare
xFilterStr2 = Interval("O27").Valoare
yFilterstr1 = Interval("p26").Valoare
yfilterstr2 = Interval("p27").Valoare
ActiveSheet.PivotTables(„Order_Comp_B2C_Crea”).PivotFields(„Numărul săptămânii”). _
ActiveSheet.PivotTables(„Order_Comp_B2B_Crea”).PivotFields(„Numărul săptămânii”). _
ActiveSheet.PivotTables(„Order_Comp_B2C_Disp”).PivotFields(„Numărul săptămânii”). _
ActiveSheet.PivotTables(„Order_Comp_B2B_Disp”).PivotFields(„Numărul săptămânii”). _
Ștergeți toate filtrele

Dacă xFilterStr1 = "" Și xFilterStr2 = "" Și yFilterstr1 = "" Și yfilterstr2 = "" Atunci Ieșiți din sub
ActiveSheet.PivotTables(„Order_Comp_B2C_Crea”).PivotFields(„Numărul săptămânii”). _
ActiveSheet.PivotTables(„Order_Comp_B2B_Crea”).PivotFields(„Numărul săptămânii”). _
ActiveSheet.PivotTables(„Order_Comp_B2C_Disp”).PivotFields(„Numărul săptămânii”). _
ActiveSheet.PivotTables(„Order_Comp_B2B_Disp”).PivotFields(„Numărul săptămânii”). _
EnableMultiplePageItems = Adevărat

xCount = ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Week Number").PivotItems.Count
xCount = ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Week Number").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Week Number").PivotItems.Count
yCount = ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Week Number").PivotItems.Count

Pentru I = 1 To xCount
Dacă eu <> xFilterStr1 Și eu <> xFilterStr2 Atunci
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Numărul săptămânii").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Numărul săptămânii").PivotItems(I).Visible = False
Altfel
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Numărul săptămânii").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Numărul săptămânii").PivotItems(I).Visible = True
Final, dacă
Pagina Următoare →

Pentru I = 1 To yCount
Dacă eu <> yFilterstr1 Și eu <> yfilterstr2 Atunci
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Numărul săptămânii").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Numărul săptămânii").PivotItems(I).Visible = False
Altfel
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Numărul săptămânii").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Numărul săptămânii").PivotItems(I).Visible = True
Final, dacă
Pagina Următoare →

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Modificați valorile în Array(), Worksheets() și Intersect()



**Găsiți-le și schimbați-le**
SheetName
E1
Tabel Pivot1
Tabel Pivot2
Tabel Pivot3




Subsol de lucrări private_Change (țintă ByVal ca rază de acțiune)
'Actualizare până la Extendoffice 20180702
Dim xPTable ca PivotTable
Dim xPFile ca PivotField

Dim xPTabled ca tabel pivot
Dim xPFiled ca PivotField

Dim xStr As String



La data de eroare CV următoare

„리스트 만들기
Dim listArray() ca variantă
listArray = Array(„PivotTable1”, „PivotTable2”, „PivotTable3”)



Dacă Intersect(Target, Range("E1")) nu este nimic, atunci ieșiți din sub
Application.ScreenUpdating = Fals

Pentru i = 0 La UBound(listArray)

Set xPTable = Foi de lucru("SheetName").PivotTables(listArray(i))
Setați xPFile = xPTable.PivotFields("Company_ID")

xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Pagina Următoare →

Application.ScreenUpdating = Adevărat



End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,

Codul merge bine pentru mine. Cu toate acestea, nu pot obține tabelul pivot pentru a actualiza automat ținta filtrului. Ținta în cazul meu este o formulă [DATA(D18,S14,C18)]. Codul funcționează doar când dau dublu clic pe celula țintă și apăsați Enter.

mulțumesc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Buna,

Acest cod funcționează perfect. Cu toate acestea, nu pot obține codul pentru a actualiza automat tabelul pivot. Valoarea țintă pentru mine este o formulă (=DATA(D18,..,..)) care se modifică în funcție de ceea ce este selectat la D18. Pentru ca acesta să actualizeze tabelul pivot, trebuie să dau dublu clic pe celula țintă și să apăs pe Enter. Există o cale de ocolire?

mulțumesc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut ST,
Să presupunem că valoarea țintă este în H6 și se modifică în funcție de valoarea din D18. Pentru a filtra un tabel pivot pe baza acestei valori țintă. Următorul cod VBA vă poate ajuta. Vă rugăm să încercați.
Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2022/07/22
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("h6")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub

Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet1").PivotTables("Pivot Table 1")
Set xPFile = xPTable.PivotFields("Category")
xStr = Target.Text
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Crystal,

Am adăugat o linie pe cod: Dim xRg As Range

Codul nu resetează automat datele când ținta este schimbată. Am un fișier Excel care reproduce ceea ce încerc să fac, însă nu pot adăuga atașamente pe acest site. D3 (țintă = DATA(A15,B15,C15)) are o ecuație legată de A15, B15 și C15. Când orice valoare pe A15, B15 și C15 este modificată, tabelul pivot se resetează la niciun filtru. M-ați putea ajuta cu asta?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut ST,
Nu prea înțeleg ce vrei să spui. În cazul dvs., valoarea celulei țintă D3 este utilizată pentru a filtra tabelul pivot. Formula din celula țintă D3 face referire la valorile celulelor A15, B15 și C15, care se vor schimba în funcție de valorile din celulele de referință. Când se modifică orice valoare pe A15, B15 și C15, tabelul pivot va fi filtrat automat dacă valoarea din celula țintă îndeplinește condițiile de filtrare ale tabelului pivot. Dacă valoarea din celula țintă nu îndeplinește criteriile de filtrare ale tabelului pivot, tabelul pivot va fi resetat automat la nicio filtrare.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Nu sunt sigur dacă există o modalitate de a vă partaja un fișier Excel. Dacă valoarea mea țintă, care este o dată, se modifică în funcție de modificările din alte celule. Trebuie să dau dublu clic pe celula țintă și să apăs pe Enter (cum ați face după ce ați introdus o formulă într-o celulă) pentru a actualiza tabelul pivot
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Sagar T,
Codul a fost actualizat. Vă rugăm să încercați. Vă mulțumim pentru feedback-ul dumneavoastră.
Nu uitați să schimbați numele foii de lucru, tabelului pivot și filtrul din cod. Sau puteți descărca următorul registru de lucru încărcat pentru testare.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220805
Dim xPTable As PivotTable
Dim xPFile As PivotField
Dim xStr As String
Dim xBoolean As Boolean
Dim xItsRG As Range
Dim xDDs As Range
Dim xDs As Range
On Error Resume Next

xBoolean = False
Set xRg = Range("D3")

Set xItsRG = Intersect(Target, xRg)
Set xDDs = Intersect(Target.DirectDependents, xRg)
Set xDs = Intersect(Target.Dependents, xRg)
If Not (xItsRG Is Nothing) Then
    xBoolean = True
ElseIf Not (xDDs Is Nothing) Then
    xBoolean = True
ElseIf Not (xDs Is Nothing) Then
    xBoolean = True
End If


If Not xBoolean Then Exit Sub
xStr = Format(xRg.Text, "m/d/yyyy")
Application.ScreenUpdating = False
Set xPTable = Worksheets("Sheet2").PivotTables("PivotTable1")
Set xPFile = xPTable.PivotFields("Date")
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True

End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
găsiți-le și modificați-le în Array(), Intersect(), Worksheets(), PivotFields()

Tabel Pivot1
Tabel Pivot2
Tabel Pivot3
Tabel Pivot4
H1
SheetName
Numele domeniului




Private Sub Worksheet_Change(ByVal Target As Range)
'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField
    Dim xPTabled As PivotTable
    Dim xPFiled As PivotField
    Dim xStr As String
    On Error Resume Next
    '리스트 만들기
    Dim listArray() As Variant
    listArray = Array("PivotTable1", "PivotTable2", "PivotTable3", "PivotTable4")
    If Intersect(Target, Range("H1")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For i = 0 To UBound(listArray)
        Set xPTable = Worksheets("SheetName").PivotTables(listArray(i))
        Set xPFile = xPTable.PivotFields("FieldName")
        'MsgBox (listArray(i))
        xStr = Target.Text
        xPFile.ClearAllFilters
        xPFile.CurrentPage = xStr
    Next
        Application.ScreenUpdating = True
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? а не 1 как в примере?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Алексей,

Vă rugăm să verificați dacă codul VBA în acest comentariu #38754 poate ajuta.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? как это сделать? подскажите пожалуйста.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Алексей,

Nu trebuie să modificați codul, trebuie doar să adăugați codul VBA în foaia de lucru a celulei pe care doriți să o referiți.
De exemplu, dacă doriți să filtrați un tabel pivot numit "Tabel Pivot1„în Sheet2 pe baza valorii celulei H6 in Sheet3, faceți clic dreapta pe Sheet3 fila fișă de lucru, faceți clic Afișați codul din meniul cu clic dreapta, apoi adăugați codul la Sheet3 (Cod) fereastră.
Nu există comentarii postate aici încă
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL