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

Hoe een draaitabelfilter aan een bepaalde cel in Excel te koppelen?

Als u een draaitabelfilter aan een bepaalde cel wilt koppelen en de draaitabel wilt filteren op basis van de celwaarde, kan de methode in dit artikel u helpen.

Koppel het draaitabelfilter aan een bepaalde cel met VBA-code

Koppel het draaitabelfilter aan een bepaalde cel met VBA-code

De draaitabel waarmee u de filterfunctie aan een celwaarde koppelt, moet een filterveld bevatten (de naam van het filterveld speelt een belangrijke rol in de volgende VBA-code).

Neem de onderstaande draaitabel als voorbeeld. Het filterveld in de draaitabel wordt aangeroepen Categorie, en het bevat twee waarden "Kosten"En"SOLDEN”. Na het koppelen van het draaitabelfilter aan een cel, moeten de celwaarden die u toepast om de draaitabel te filteren "Uitgaven" en "Verkoop" zijn.

1. Selecteer de cel (hier selecteer ik cel H6) die u wilt koppelen aan de filterfunctie van de draaitabel en voer vooraf een van de filterwaarden in de cel in.

2. Open het werkblad met de draaitabel die u aan de cel wilt koppelen. Klik met de rechtermuisknop op de bladtab en selecteer Bekijk code vanuit het contextmenu. Zie screenshot:

3. In de Microsoft Visual Basic voor toepassingen -venster, kopieer onderstaande VBA-code naar het codevenster.

VBA-code: koppel draaitabelfilter aan een bepaalde cel

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

Opmerkingen:

1) "Sheet1”Is de naam van het geopende werkblad.
2) "Draaitabel2”Is de naam van de draaitabel en u koppelt de filterfunctie aan een cel.
3) Het filterveld in de draaitabel wordt 'Categorie".
4) De cel waarnaar wordt verwezen, is H6. U kunt deze variabelewaarden wijzigen op basis van uw behoeften.

4. druk de anders + Q toetsen om de Microsoft Visual Basic voor toepassingen venster.

Nu is de filterfunctie van de draaitabel gekoppeld aan cel H6.

Vernieuw de cel H6, waarna de overeenkomstige gegevens in de draaitabel worden uitgefilterd op basis van de bestaande waarde. Zie screenshot:

Wanneer u de celwaarde wijzigt, worden de gefilterde gegevens in de draaitabel automatisch gewijzigd. Zie screenshot:

Selecteer eenvoudig hele rijen op basis van de celwaarde in een certian-kolom:

De Selecteer specifieke cellen nut van Kutools for Excel kan u helpen snel hele rijen te selecteren op basis van de celwaarde in een certian-kolom in Excel, zoals onderstaand screenshot. Nadat u alle rijen op basis van de celwaarde hebt geselecteerd, kunt u ze handmatig verplaatsen of kopiëren naar een nieuwe locatie in Excel.
Download en probeer het nu! (30-dag vrij parcours)

Gerelateerde artikelen:

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2021 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Volledige functies Gratis proefperiode van 30 dagen. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!
officetab onderkant
Heb je vragen? Stel ze hier. (36)
Nog geen beoordelingen. Beoordeel als eerste!
openhartig
openhartig
Deze opmerking is gemaakt door de moderator op de site
hoe het op meerdere velden te doen, omdat er in de code maar één doel is
Antwoorden
0
0
crystal
crystal     openhartig
Deze opmerking is gemaakt door de moderator op de site
Hallo Frank
Daar kan Sory je niet mee helpen.
Antwoorden
Rapport
0
0
Sara
Sara
Deze opmerking is gemaakt door de moderator op de site
Wat als de cel die aan de draaitabel is gekoppeld, in dit geval H6, op een ander werkblad staat? Hoe verandert het de code?
Antwoorden
0
0
Jeri
Jeri
Deze opmerking is gemaakt door de moderator op de site
wat als ik meer dan 1 draaitabel heb en naar 1 cel wil linken. Hoe moet ik de code wijzigen?
Antwoorden
0
0
crystal
crystal     Jeri
Deze opmerking is gemaakt door de moderator op de site
Hallo Jeri,
Sorry kan je daar niet mee helpen. Welkom bij het plaatsen van een vraag op ons forum: https://www.extendoffice.com/forum.html om meer Excel-ondersteuning te krijgen van onze Excel-professional of andere Excel-fans.
Antwoorden
Rapport
0
0
iamjuneyong2
iamjuneyong2     Jeri
Deze opmerking is gemaakt door de moderator op de site
zoek deze op en verander het in Array(),Intersect(), Worksheets(), PivotFields()

Draaitabel1
Draaitabel2
Draaitabel3
Draaitabel4
H1
Bladnaam
Veldnaam




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
Antwoorden
Rapport
0
0
Gilmar Alves
Gilmar Alves
Deze opmerking is gemaakt door de moderator op de site
Boa tarde...! Publicatie, como faço para utilizar of filtro em duas ou mais tableas dinâmicas...? Agradeço desde já.

Goedenmiddag...! Geweldig publiceren, hoe gebruik ik het filter in twee of meer draaitabellen ...? Bij voorbaat dank.
Antwoorden
0
0
crystal
crystal     Gilmar Alves
Deze opmerking is gemaakt door de moderator op de site
Hallo Gilmar Alves,
Sorry kan je daar niet mee helpen. Welkom bij het plaatsen van een vraag op ons forum: https://www.extendoffice.com/forum.html om meer Excel-ondersteuning te krijgen van onze Excel-professional of andere Excel-fans.
Antwoorden
Rapport
0
0
Michael
Michael     crystal
Deze opmerking is gemaakt door de moderator op de site
Heeft iemand de vraag over het koppelen van meerdere draaitabellen bedacht?
Antwoorden
0
0
juniyong
juniyong     Gilmar Alves
Deze opmerking is gemaakt door de moderator op de site
Waarden wijzigen in Array(), Worksheets() en Intersect()



**Vind deze en verander het**
Bladnaam
E1
Draaitabel1
Draaitabel2
Draaitabel3




Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'Bijwerken door' Extendoffice 20180702
Dim xPTable als draaitabel
Dim xPFile als draaiveld

Dim xPTabled als draaitabel
Dim xPGearchiveerd als draaiveld

Dim xStr als tekenreeks



On Error Resume Next

'리스트
Dim lijstArray() als variant
listArray = Array ("PivotTable1", "PivotTable2", "PivotTable3")



Als Intersect (Target, Range ("E1")) niets is, sluit dan Sub af
Application.ScreenUpdating = False

Voor i = 0 Naar UBound(listArray)

Stel xPTable = Worksheets ("Bladnaam") in. Draaitabellen (listArray(i))
Stel xPFile = xPTable.PivotFields ("Company_ID") in

xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Volgende

Application.ScreenUpdating = True



End Sub
Antwoorden
0
0
Elisa
Elisa
Deze opmerking is gemaakt door de moderator op de site
Ciao, u kunt een tarief van stesso esempio per far in modo che il filtro della pivot si setti sul valore della cella instellen,
niet riesco a farla funzionare.

Is het mogelijk om een ​​beschrijving te geven?
Antwoorden
0
0
crystal
crystal     Elisa
Deze opmerking is gemaakt door de moderator op de site
Hoi,
Heb je een foutmelding gekregen? Ik wil meer specifiek weten over uw probleem, zoals uw Excel-versie. En als je het niet erg vindt, probeer dan je gegevens in een nieuwe werkmap te maken en probeer het opnieuw, of maak een screenshot van je gegevens en upload deze hier.
Antwoorden
Rapport
0
0
Justin
Justin
Deze opmerking is gemaakt door de moderator op de site
Hoi,

Geprobeerd om dit werkend te krijgen voor het kolomfilter, maar lijkt niet te werken. Heb ik daar een andere code voor nodig?

Bedankt
Antwoorden
0
0
crystal
crystal     Justin
Deze opmerking is gemaakt door de moderator op de site
Hoi Justin,
Heb je een foutmelding gekregen? Ik moet meer specifiek weten over uw probleem.
Voordat u de code toepast, vergeet dan niet om de "naam van het blad''naam van de draaitabel''naam van het filter van de draaitabel" en de cel waarop u de draaitabel wilt filteren (zie sceenshot).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Antwoorden
Rapport
0
0
Justin Teeuwen
Justin Teeuwen     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Bedankt voor je hulp. Het probleem is dat de functie om de een of andere reden niets doet. Enige verduidelijking:

Draainaam: Order_Comp_B2C
Bladnaam: Berekeningsblad
Filternaam: Weeknummer (ik heb deze naam veranderd van wat "Verzendweeknummer" was in het gegevensbestand)
Te wijzigen cel: O26 en O27 (dit moet binnen bereik vallen)

In deze spil probeer ik het filter voor de kolommen te wijzigen, ik heb niets in het filtergebied in het menu Draaitabelvelden.

mijn code is:

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'Bijwerken door' Extendoffice 20180702
Dim xPTable als draaitabel
Dim xPFile als draaiveld
Dim xStr als tekenreeks
On Error Resume Next
Als Intersect (Target, Range ("O26")) niets is, sluit dan Sub af
Application.ScreenUpdating = False
Stel xPTable = Worksheets ("Rekenblad") in. Draaitabellen ("Order_Comp_B2C")
Stel xPFile = xPTable.PivotFields ("Weeknummer") in
xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Hartelijk dank,

Justin
Antwoorden
Rapport
0
0
crystal
crystal     Justin Teeuwen
Deze opmerking is gemaakt door de moderator op de site
Hallo Justin Teeuwen,
Ik heb de Draainaam, bladnaam, filternaam en cel om te veranderen aan de voorwaarden die u hierboven noemde en de door u verstrekte VBA-code hebt geprobeerd, werkt het goed in mijn geval. Zie de volgende GIF of de bijgevoegde werkmap.
Vind je het erg om een ​​nieuwe werkmap te maken en de code opnieuw te proberen?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Bekijk bijlagen (1 / 5)
Antwoorden
Rapport
0
0
Justin Teeuwen
Justin Teeuwen     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Bijgevoegd een screenshot van de spil, het rode vak is het filter dat ik zou willen wijzigen op basis van de celwaarde.

Bij voorkeur zou ik een reeks cellen willen gebruiken die meerdere weeknummers aangeeft.

Hartelijk dank,

Justin
Antwoorden
Rapport
0
0
crystal
crystal     Justin Teeuwen
Deze opmerking is gemaakt door de moderator op de site
Hoi Justin,
Sorry, ik heb de screenshot die je op de pagina hebt bijgevoegd niet gezien. Misschien staat er een fout op de pagina.
Als je het probleem nog steeds moet oplossen, stuur me dan een e-mail via zxm@addin99.com. Excuses voor het ongemak.
Rapport
0
0
crystal
crystal     Justin Teeuwen
Deze opmerking is gemaakt door de moderator op de site
Hallo Justin Teeuw，
Probeer de volgende VBA-code. Hoop dat ik kan helpen.

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
Rapport
0
0
maziartib4 TIB
maziartib4 TIB
Deze opmerking is gemaakt door de moderator op de site
Ik gebruikte het voor een normale Excell en het werkte. Maar ik kon het niet gebruiken voor een olap-werkbladen. misschien moet ik het een beetje veranderen?
Antwoorden
Rapport
0
0
crystal
crystal     maziartib4 TIB
Deze opmerking is gemaakt door de moderator op de site
Hallo maziritib4 TIB,
De methode is alleen beschikbaar voor Microsoft Excel. Excuses voor het ongemak.
Antwoorden
Rapport
0
0
James
James
Deze opmerking is gemaakt door de moderator op de site
Hoi Justin,

Dit heeft perfect gewerkt, maar ik vraag me af of deze regel kan worden toegepast op meerdere draaitabellen binnen hetzelfde blad?

Hartelijk dank,
James
Antwoorden
0
0
Justin Teeuwen
Justin Teeuwen     James
Deze opmerking is gemaakt door de moderator op de site
Hi James,

Ja dit is mogelijk, de code die ik hiervoor heb gebruikt is (4 pivots en 2 celverwijzingen):

Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
Dim ik als geheel getal
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 als tekenreeks
On Error Resume Next
Als Intersect (Target, Range ("O26:P27")) niets is, sluit dan Sub af

xFilterStr1 = Bereik ("O26"). Waarde
xFilterStr2 = Bereik ("O27"). Waarde
yFilterstr1 = Bereik ("p26"). Waarde
yfilterstr2 = Bereik ("p27"). Waarde
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Weeknummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Weeknummer"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Weeknummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Weeknummer"). _
Alles wissenFilters

Als xFilterStr1 = "" En xFilterStr2 = "" En yFilterstr1 = "" En yfilterstr2 = "" Sluit Sub dan af
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Weeknummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Weeknummer"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Weeknummer"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Weeknummer"). _
EnableMultiplePageItems = Waar

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

Voor I = 1 Tot xCount
Als ik <> xFilterStr1 en ik <> xFilterStr2 Dan
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Weeknummer").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Weeknummer").PivotItems(I).Visible = False
Anders
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Weeknummer").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Weeknummer").PivotItems(I).Visible = True
End If
Volgende

Voor I = 1 Tot yTellen
Als ik <> yFilterstr1 En ik <> yfilterstr2 Dan
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Weeknummer").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Weeknummer").PivotItems(I).Visible = False
Anders
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Weeknummer").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Weeknummer").PivotItems(I).Visible = True
End If
Volgende

End Sub
Antwoorden
Rapport
0
0
juniyong
juniyong     James
Deze opmerking is gemaakt door de moderator op de site
Waarden wijzigen in Array(), Worksheets() en Intersect()



**Vind deze en verander het**
Bladnaam
E1
Draaitabel1
Draaitabel2
Draaitabel3




Particulier subwerkblad_Wijziging (ByVal-doel als bereik)
'Bijwerken door' Extendoffice 20180702
Dim xPTable als draaitabel
Dim xPFile als draaiveld

Dim xPTabled als draaitabel
Dim xPGearchiveerd als draaiveld

Dim xStr als tekenreeks



On Error Resume Next

'리스트
Dim lijstArray() als variant
listArray = Array ("PivotTable1", "PivotTable2", "PivotTable3")



Als Intersect (Target, Range ("E1")) niets is, sluit dan Sub af
Application.ScreenUpdating = False

Voor i = 0 Naar UBound(listArray)

Stel xPTable = Worksheets ("Bladnaam") in. Draaitabellen (listArray(i))
Stel xPFile = xPTable.PivotFields ("Company_ID") in

xStr = Doel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Volgende

Application.ScreenUpdating = True



End Sub
Antwoorden
0
0
ST
ST
Deze opmerking is gemaakt door de moderator op de site
Hallo,

Bij mij werkt de code prima. Ik kan de draaitabel echter niet zover krijgen dat het filterdoel automatisch wordt bijgewerkt. Het doel in mijn geval is een formule [DATE(D18,S14,C18)]. De code werkt alleen als ik dubbelklik op de doelcel en op enter druk.

Bedankt
Antwoorden
0
0
ST
ST
Deze opmerking is gemaakt door de moderator op de site
Hallo,

Deze code werkt perfect. Ik kan de code echter niet krijgen om de draaitabel automatisch bij te werken. De streefwaarde voor mij is een formule (=DATE(D18,..,..)) die verandert afhankelijk van wat er is geselecteerd bij D18. Om de draaitabel bij te werken, moet ik dubbelklikken op de doelcel en op enter drukken. Is er een manier om het heen?

Bedankt
Antwoorden
0
0
crystal
crystal     ST
Deze opmerking is gemaakt door de moderator op de site
Hallo ST,
Stel dat uw streefwaarde in H6 ligt en deze verandert afhankelijk van de waarde in D18. Een draaitabel filteren op basis van deze doelwaarde. De volgende VBA-code kan helpen. Probeer het alsjeblieft.
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
Antwoorden
Rapport
0
0
ST
ST     crystal
Deze opmerking is gemaakt door de moderator op de site
Hallo Kristal,

Ik heb een regel toegevoegd aan de code: Dim xRg As Range

De code stelt de datums niet automatisch opnieuw in wanneer het doel wordt gewijzigd. Ik heb een Excel-bestand dat repliceert wat ik probeer te doen, maar ik kan geen bijlagen op deze website toevoegen. D3 (doel = DATUM(A15,B15,C15)) heeft een vergelijking die is gekoppeld aan A15, B15 en C15. Wanneer een waarde op A15, B15 en C15 wordt gewijzigd, wordt de draaitabel opnieuw ingesteld op geen filter. Kunt u mij hierbij helpen?
Antwoorden
0
0
crystal
crystal     ST
Deze opmerking is gemaakt door de moderator op de site
Hallo ST,
Ik begrijp niet helemaal wat je bedoelt. In uw geval wordt de waarde van doelcel D3 gebruikt om de draaitabel te filteren. De formule in de doelcel D3 verwijst naar de waarden van de cellen A15, B15 en C15, die zullen veranderen volgens de waarden in de referentiecellen. Wanneer een waarde op A15, B15 en C15 wordt gewijzigd, wordt de draaitabel automatisch gefilterd als de waarde in de doelcel voldoet aan de filtervoorwaarden van de draaitabel. Als de waarde in de doelcel niet voldoet aan de filtercriteria van de draaitabel, wordt de draaitabel automatisch teruggezet naar geen filtering.
Antwoorden
Rapport
0
0
Sagar T
Sagar T     crystal
Deze opmerking is gemaakt door de moderator op de site
Ik weet niet zeker of er een manier is om een ​​Excel-bestand met u te delen. Als mijn doelwaarde, wat een datum is, verandert op basis van veranderingen in andere cellen. Ik moet dubbelklikken op de doelcel en op enter drukken (zoals je zou doen na het invoeren van een formule in een cel) om de draaitabel bij te werken
Antwoorden
0
0
crystal
crystal     Sagar T
Deze opmerking is gemaakt door de moderator op de site
Hallo SagarT,
De code is bijgewerkt. Probeer het alsjeblieft. Bedankt voor uw feedback.
Vergeet niet de namen van het werkblad, de draaitabel en het filter in de code te wijzigen. Of u kunt de volgende geüploade werkmap downloaden om te testen.

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
Bekijk bijlagen (1 / 5)
Rapport
0
0
iamjuneyong2
iamjuneyong2
Deze opmerking is gemaakt door de moderator op de site
zoek deze op en verander het in Array(),Intersect(), Worksheets(), PivotFields()

Draaitabel1
Draaitabel2
Draaitabel3
Draaitabel4
H1
Bladnaam
Veldnaam




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
Antwoorden
Rapport
0
0
Alexey
Alexey
Deze opmerking is gemaakt door de moderator op de site
Wilt u weten of het apparaat 2 of 2 keer zo lang is? nog geen 1 jaar geleden?
Antwoorden
0
0
crystal
crystal     Alexey
Deze opmerking is gemaakt door de moderator op de site
Hallo Алексей,

Controleer of de VBA-code in dit commentaar #38754 kan helpen.
Antwoorden
Rapport
0
0
Alexey
Alexey
Deze opmerking is gemaakt door de moderator op de site
Is het mogelijk dat de H6 op de hoogte wordt gehouden? hoe werkt het? verwijder het apparaat.
Antwoorden
0
0
crystal
crystal     Alexey
Deze opmerking is gemaakt door de moderator op de site
Hallo Алексей,

U hoeft de code niet te wijzigen, voeg gewoon de VBA-code toe aan het werkblad van de cel waarnaar u wilt verwijzen.
Als u bijvoorbeeld een draaitabel met de naam "Draaitabel1"In Sheet2 gebaseerd op de waarde van de cel H6 in Sheet3, klik met de rechtermuisknop op de Sheet3 tabblad werkblad, klik Bekijk code vanuit het rechtsklikmenu en voeg vervolgens de code toe aan het Blad3 (Code) venster.
Antwoorden
Rapport
0
0
Er zijn nog geen reacties geplaatst
Laat uw commentaar
Gast
Posten als gast
Inloggen
×
Beoordeel dit bericht:
Reset
0   Personages
Voorgestelde locaties

Volg ons

Copyright © 2009 - www.extendoffice.com. | Alle rechten voorbehouden. Aangedreven door ExtendOffice. | Sitemap
Microsoft en het Office-logo zijn handelsmerken of gedeponeerde handelsmerken van Microsoft Corporation in de Verenigde Staten en / of andere landen.
Beschermd door Sectigo SSL