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

Jak połączyć filtr tabeli przestawnej z określoną komórką w programie Excel?

Jeśli chcesz połączyć filtr tabeli przestawnej z określoną komórką i ustawić filtrowanie tabeli przestawnej na podstawie wartości komórki, może Ci pomóc metoda opisana w tym artykule.

Połącz filtr tabeli przestawnej z określoną komórką za pomocą kodu VBA


Połącz filtr tabeli przestawnej z określoną komórką za pomocą kodu VBA

Tabela przestawna, którą połączysz jej funkcję filtrującą z wartością komórki, powinna zawierać pole filtru (nazwa pola filtru odgrywa ważną rolę w poniższym kodzie VBA).

Jako przykład weźmy poniższą tabelę przestawną: Pole filtru w tabeli przestawnej nazywa się Wszystkie produktyi zawiera dwie wartości „Wydatki"I"Obroty”. Po połączeniu filtru tabeli przestawnej z komórką wartościami komórek, które zastosujesz do filtru tabeli przestawnej, powinny być „Wydatki” i „Sprzedaż”.

1. Proszę wybrać komórkę (tutaj wybieram komórkę H6), do której będzie można połączyć się z funkcją filtrującą tabeli przestawnej, i z góry wprowadź jedną z wartości filtru do komórki.

2. Otwórz arkusz zawierający tabelę przestawną, którą połączysz z komórką. Kliknij prawym przyciskiem myszy kartę arkusza i wybierz Wyświetl kod z menu kontekstowego. Zobacz zrzut ekranu:

3. w Microsoft Visual Basic for Applications skopiuj poniższy kod VBA do okna Code.

Kod VBA: Połącz filtr tabeli przestawnej z określoną komórką

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

Uwagi:

1) "Sheet1”To nazwa otwartego arkusza.
2) "Tabela przestawna 2”To nazwa tabeli przestawnej, której funkcja filtrująca zostanie połączona z komórką.
3) Pole filtrujące w tabeli przestawnej nosi nazwę „Wszystkie produkty".
4) Odwoływana komórka to H6. Możesz zmienić te wartości zmiennych w zależności od potrzeb.

4. wciśnij inny + Q klucze do zamknięcia Microsoft Visual Basic for Applications okno.

Teraz funkcja filtrująca tabeli przestawnej jest połączona z komórką H6.

Odśwież komórkę H6, a następnie odpowiednie dane w tabeli przestawnej zostaną odfiltrowane na podstawie istniejącej wartości. Zobacz zrzut ekranu:

Podczas zmiany wartości komórki przefiltrowane dane w tabeli przestawnej zostaną automatycznie zmienione. Zobacz zrzut ekranu:


Z łatwością zaznaczaj całe wiersze na podstawie wartości komórki w kolumnie certian:

Podróż Ruta de la Plata w liczbach Wybierz określone komórki użyteczność Kutools dla programu Excel może pomóc ci szybko wybrać całe wiersze na podstawie wartości komórki w kolumnie certian w programie Excel, jak pokazano poniżej. Po wybraniu wszystkich wierszy na podstawie wartości komórki możesz ręcznie przenieść lub skopiować je do nowej lokalizacji, zgodnie z potrzebami w programie Excel.
Pobierz i wypróbuj teraz! (30-dzień wolny szlak)


Podobne artykuły:


Najlepsze narzędzia biurowe

Kutools dla programu Excel rozwiązuje większość problemów i zwiększa produktywność o 80%

  • Ponowne użycie: Szybko włóż złożone wzory, wykresy i wszystko, czego używałeś wcześniej; Szyfruj komórki z hasłem; Utwórz listę mailingową i wysyłaj e-maile ...
  • Pasek Super Formula (łatwo edytować wiele wierszy tekstu i formuły); Układ do czytania (łatwe odczytywanie i edytowanie dużej liczby komórek); Wklej do filtrowanego zakresu...
  • Scal komórki / wiersze / kolumny bez utraty danych; Podziel zawartość komórek; Połącz zduplikowane wiersze / kolumny... Zapobiegaj zduplikowanym komórkom; Porównaj zakresy...
  • Wybierz Duplikat lub Unikalny Wydziwianie; Wybierz puste wiersze (wszystkie komórki są puste); Super Find i Fuzzy Find w wielu zeszytach ćwiczeń; Losowy wybór ...
  • Dokładna kopia Wiele komórek bez zmiany odwołania do formuły; Automatyczne tworzenie odniesień do wielu arkuszy; Wstaw punktory, Pola wyboru i nie tylko ...
  • Wyodrębnij tekst, Dodaj tekst, Usuń według pozycji, Usuń przestrzeń; Tworzenie i drukowanie podsumowań stronicowania; Konwertuj zawartość komórek i komentarze...
  • Super filtr (zapisz i zastosuj schematy filtrów do innych arkuszy); Zaawansowane sortowanie według miesiąca / tygodnia / dnia, częstotliwości i innych; Specjalny filtr pogrubieniem, kursywą ...
  • Połącz skoroszyty i arkusze robocze; Scal tabele na podstawie kluczowych kolumn; Podziel dane na wiele arkuszy; Konwersja wsadowa xls, xlsx i PDF...
  • Ponad 300 zaawansowanych funkcji. Obsługuje Office / Excel 2007-2021 i 365. Obsługuje wszystkie języki. Łatwe wdrażanie w przedsiębiorstwie lub organizacji. Pełne funkcje 30-dniowa bezpłatna wersja próbna. 60-dniowa gwarancja zwrotu pieniędzy.
karta kte 201905

Karta Office wprowadza interfejs z zakładkami do pakietu Office i znacznie ułatwia pracę

  • Włącz edycję i czytanie na kartach w programach Word, Excel, PowerPoint, Publisher, Access, Visio i Project.
  • Otwieraj i twórz wiele dokumentów w nowych kartach tego samego okna, a nie w nowych oknach.
  • Zwiększa produktywność o 50% i redukuje setki kliknięć myszką każdego dnia!
officetab dół
Sortuj komentarze według
Komentarze (36)
Brak ocen. Oceń jako pierwszy!
Ten komentarz został zminimalizowany przez moderatora na stronie
jak to zrobić na polu multi;tiple skoro w kodzie jest tylko jeden cel
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Frank
Sory nie może ci w tym pomóc.
Ten komentarz został zminimalizowany przez moderatora na stronie
Co się stanie, jeśli komórka połączona z tabelą przestawną, w tym przypadku H6, znajduje się w innym arkuszu? Jak zmienia kod?
Ten komentarz został zminimalizowany przez moderatora na stronie
co jeśli mam więcej niż 1 tabelę przestawną i link do 1 komórki. Jak zmienić kod?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Jeri,
Przepraszam, nie mogę ci w tym pomóc. Zapraszamy do zadawania pytań na naszym forum: https://www.extendoffice.com/forum.html aby uzyskać więcej wsparcia Excel od naszych profesjonalistów Excel lub innych fanów Excela.
Ten komentarz został zminimalizowany przez moderatora na stronie
znajdź je i zmień w Array(),Intersect(), Worksheets(), PivotFields()

Tabela przestawna 1
Tabela przestawna 2
Tabela przestawna 3
Tabela przestawna 4
H1
Nazwa arkusza
Nazwa pola




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
Ten komentarz został zminimalizowany przez moderatora na stronie
Boa tarde...! Ótima publicação, como faço para utilizar lub filtr w duecie lub w tabelach Dinâmicas...? Agradeço desde já.

Dzień dobry...! Świetne publikowanie, jak używać filtra w dwóch lub więcej tabelach przestawnych...? Z góry dziękuję.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Gilmar Alves,
Przepraszam, nie mogę ci w tym pomóc. Zapraszamy do zadawania pytań na naszym forum: https://www.extendoffice.com/forum.html aby uzyskać więcej wsparcia Excel od naszych profesjonalistów Excel lub innych fanów Excela.
Ten komentarz został zminimalizowany przez moderatora na stronie
Czy ktoś wymyślił pytanie dotyczące łączenia wielu tabel przestawnych?
Ten komentarz został zminimalizowany przez moderatora na stronie
Zmień wartości w Array(), Worksheets() i Intersect()



**Znajdź je i zmień**
Nazwa arkusza
E1
Tabela przestawna 1
Tabela przestawna 2
Tabela przestawna 3




Prywatny Sub Worksheet_Change (ByVal Target As Range)
'Aktualizuj do Extendoffice 20180702
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField

Dim xPTabled jako tabela przestawna
Dim xPFfiled jako PivotField

Dim xStr jako ciąg



On Error Resume Next

'리스트 만들기
Dim listArray() jako wariant
listArray = Array("Tabela przestawna1", "Tabela przestawna2", "Tabela przestawna3")



Jeśli przecięcie(cel, zakres("E1")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz

Dla i = 0 To UBound(listArray)

Ustaw xPTable = Worksheets("NazwaArkusza").PivotTables(listArray(i))
Ustaw xPFile = xPTable.PivotFields("Identyfikator_firmy")

xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Dalej

Application.ScreenUpdating = True



End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Ciao, sto provando a fare lo stesso esempio per far in modo che il filtro della pivot si setti sul valore della cella,
non riesco a farla funzionare.

Quale passaggio manca nella descrizione sopra?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,
Czy otrzymałeś komunikat o błędzie? Muszę dowiedzieć się więcej o Twoim problemie, na przykład o wersji programu Excel. A jeśli nie masz nic przeciwko, spróbuj utworzyć swoje dane w nowym skoroszycie i spróbuj ponownie lub zrób zrzut ekranu swoich danych i prześlij go tutaj.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Próbowałem sprawić, by to działało dla filtra kolumn, ale wydaje się, że nie działa. Czy potrzebuję do tego innego kodu?

Podziękowania
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Justin,
Czy otrzymałeś komunikat o błędzie? Muszę dowiedzieć się więcej o Twoim problemie.
Przed zastosowaniem kodu nie zapomnij zmodyfikować „nazwa arkusza""nazwa tabeli przestawnej""nazwa filtra tabeli przestawnej”i komórka na podstawie której chcesz filtrować tabelę przestawną (patrz zrzut ekranu).
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/4.png
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,

Dzięki za pomoc. Problem polega na tym, że funkcja z jakiegoś powodu nic nie robi. Niektóre wyjaśnienia:

Nazwa przestawna: Order_Comp_B2C
Nazwa arkusza: Arkusz obliczeniowy
Nazwa filtra: Numer tygodnia (zmieniłem tę nazwę z „Nr tygodnia wysyłki” w pliku danych)
Komórka do zmiany: O26 i O27 (powinna mieścić się w zakresie)

W tej osi próbuję zmienić filtr dla kolumn, nie mam nic w obszarze filtrów w menu Pola tabeli przestawnej.

mój kod to:

Prywatny Sub Worksheet_Change (ByVal Target As Range)
'Aktualizuj do Extendoffice 20180702
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField
Dim xStr jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("O26")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz
Ustaw xPTable = Worksheets("Arkusz obliczeniowy").PivotTables("Order_Comp_B2C")
Ustaw xPFile = xPTable.PivotFields("Numer tygodnia")
xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr
Application.ScreenUpdating = True
End Sub

Dzięki,

Justin
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Justin Teeuw,
zmieniłem Nazwa przestawna, nazwa arkusza, nazwa filtra i komórka do zmiany warunki, które wymieniłeś powyżej i wypróbowałeś kod VBA, który podałeś, działa dobrze w moim przypadku. Zobacz następujący plik GIF lub załączony skoroszyt.
Czy masz coś przeciwko utworzeniu nowego skoroszytu i ponownej próbie kodu?
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/6.gif
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Kryształowo,

Załączony zrzut ekranu z osią, czerwone pole to filtr, który chciałbym zmienić na podstawie wartości komórki.

Najlepiej byłoby użyć zakresu komórek wskazujących wiele tygodni.

Dzięki,

Justin
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Justin,
Przepraszam, że nie widziałem zrzutu ekranu, który załączyłeś na stronie. Może na stronie jest jakiś błąd.
Jeśli nadal musisz rozwiązać problem, napisz do mnie na adres zxm@addin99.com. Przepraszam za niedogodności.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Justin Teeuw,
Wypróbuj następujący kod VBA. Mam nadzieję, że mogę pomóc.

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
Ten komentarz został zminimalizowany przez moderatora na stronie
Użyłem go do normalnego programu Excel i zadziałało. Ale nie mogłem go użyć do arkuszy roboczych olap. może muszę to trochę zmienić?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć maziaritib4 TIB,
Metoda jest dostępna tylko dla Microsoft Excel. Przepraszam za niedogodności.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Justin,

Działa to doskonale, jednak zastanawiam się, czy tę regułę można zastosować do wielu tabel przestawnych w tym samym arkuszu?

Dzięki,
James
Ten komentarz został zminimalizowany przez moderatora na stronie
Hi James,

Tak, jest to możliwe, kod, którego użyłem do tego, to (4 czopy i 2 odwołania do komórek):

Prywatny Sub Worksheet_Change (ByVal Target As Range)
Dim I jako liczba całkowita
Dim xFilterStr1, xFilterStr2, yFilterstr1, yfilterstr2 Jako ciąg
On Error Resume Next
Jeśli przecięcie(cel, zakres("O26:P27")) jest niczym, to zakończ Sub

xFilterStr1 = Zakres("O26").Wartość
xFilterStr2 = Zakres("O27").Wartość
yFilterstr1 = Zakres("p26").Wartość
yfilterstr2 = Zakres("p27").Wartość
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Numer tygodnia"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Numer tygodnia"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Numer tygodnia"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Numer tygodnia"). _
Wyczyść wszystkie filtry

If xFilterStr1 = "" And xFilterStr2 = "" And yFilterstr1 = "" And yfilterstr2 = "" Następnie wyjdź z Sub
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Numer tygodnia"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Numer tygodnia"). _
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Numer tygodnia"). _
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Numer tygodnia"). _
EnableMultiplePageItems = Prawda

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

Dla I = 1 do xCount
Jeśli ja <> xFilterStr1 i ja <> xFilterStr2 Wtedy
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Numer tygodnia").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Numer tygodnia").PivotItems(I).Visible = False
Więcej
ActiveSheet.PivotTables("Order_Comp_B2C_Crea").PivotFields("Numer tygodnia").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Crea").PivotFields("Numer tygodnia").PivotItems(I).Visible = True
End If
Dalej

Dla I = 1 do yCount
Jeśli ja <> yFilterstr1 I ja <> yfilterstr2 Wtedy
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Numer tygodnia").PivotItems(I).Visible = False
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Numer tygodnia").PivotItems(I).Visible = False
Więcej
ActiveSheet.PivotTables("Order_Comp_B2C_Disp").PivotFields("Numer tygodnia").PivotItems(I).Visible = True
ActiveSheet.PivotTables("Order_Comp_B2B_Disp").PivotFields("Numer tygodnia").PivotItems(I).Visible = True
End If
Dalej

End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Zmień wartości w Array(), Worksheets() i Intersect()



**Znajdź je i zmień**
Nazwa arkusza
E1
Tabela przestawna 1
Tabela przestawna 2
Tabela przestawna 3




Prywatny Sub Worksheet_Change (ByVal Target As Range)
'Aktualizuj do Extendoffice 20180702
Przyciemnij xPTable jako tabelę przestawną
Dim xPFile jako PivotField

Dim xPTabled jako tabela przestawna
Dim xPFfiled jako PivotField

Dim xStr jako ciąg



On Error Resume Next

'리스트 만들기
Dim listArray() jako wariant
listArray = Array("Tabela przestawna1", "Tabela przestawna2", "Tabela przestawna3")



Jeśli przecięcie(cel, zakres("E1")) jest niczym, to zakończ Sub
Application.ScreenUpdating = Fałsz

Dla i = 0 To UBound(listArray)

Ustaw xPTable = Worksheets("NazwaArkusza").PivotTables(listArray(i))
Ustaw xPFile = xPTable.PivotFields("Identyfikator_firmy")

xStr = Cel.Tekst
xPFile.ClearAllFilters
xPFile.CurrentPage = xStr



Dalej

Application.ScreenUpdating = True



End Sub
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Kod działa dla mnie dobrze. Jednak nie jestem w stanie uzyskać tabeli przestawnej, aby automatycznie zaktualizować cel filtra. W moim przypadku celem jest formuła [DATA(D18,S14,C18)]. Kod działa tylko wtedy, gdy dwukrotnie klikam komórkę docelową i wciskam enter.

Dziękuję Ci
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć,

Ten kod działa idealnie. Jednak nie mogę uzyskać kodu do automatycznej aktualizacji tabeli przestawnej. Dla mnie wartością docelową jest formuła (=DATA(D18,..,..)), która zmienia się w zależności od tego, co zostało wybrane w D18. Aby zaktualizować tabelę przestawną, muszę dwukrotnie kliknąć komórkę docelową i nacisnąć Enter. Czy można to obejść?

Dziękuję Ci
Ten komentarz został zminimalizowany przez moderatora na stronie
Witaj ST,
Załóżmy, że wartość docelowa znajduje się w H6 i zmienia się w zależności od wartości w D18. Aby filtrować tabelę przestawną na podstawie tej wartości docelowej. Poniższy kod VBA może pomóc. Proszę spróbować.
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
Ten komentarz został zminimalizowany przez moderatora na stronie
Witaj Krysalu,

Dodałem linię na kodzie : Dim xRg As Range

Kod nie resetuje automatycznie dat po zmianie celu. Mam plik Excela, który replikuje to, co próbuję zrobić, ale nie mogę dodać załączników na tej stronie. D3 (cel = DATA(A15,B15,C15)) ma równanie powiązane z A15, B15 i C15. Gdy jakakolwiek wartość w A15, B15 i C15 zostanie zmieniona, tabela przestawna zostanie zresetowana bez filtra. Czy możesz mi w tym pomóc?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć ST,
Nie bardzo rozumiem, co masz na myśli. W Twoim przypadku wartość komórki docelowej D3 służy do filtrowania tabeli przestawnej. Formuła w komórce docelowej D3 odwołuje się do wartości komórek A15, B15 i C15, które zmienią się zgodnie z wartościami w komórkach odniesienia. Po zmianie dowolnej wartości w A15, B15 i C15 tabela przestawna zostanie automatycznie przefiltrowana, jeśli wartość w komórce docelowej spełnia warunki filtrowania tabeli przestawnej. Jeśli wartość w komórce docelowej nie spełnia kryteriów filtrowania tabeli przestawnej, tabela przestawna zostanie automatycznie zresetowana bez filtrowania.
Ten komentarz został zminimalizowany przez moderatora na stronie
Nie jestem pewien, czy istnieje sposób udostępnienia Ci pliku Excela. Jeśli moja wartość docelowa, którą jest data, zmienia się zgodnie ze zmianami w innych komórkach. Muszę dwukrotnie kliknąć komórkę docelową i nacisnąć Enter (tak jak po wprowadzeniu formuły w komórce), aby zaktualizować tabelę przestawną
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Sagar T,
Kod został zaktualizowany. Proszę spróbować. Dziękuję za twój komentarz.
Nie zapomnij zmienić nazw arkusza roboczego, tabeli przestawnej i filtra w kodzie. Możesz też pobrać następujący przesłany skoroszyt do testowania.

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
Ten komentarz został zminimalizowany przez moderatora na stronie
znajdź je i zmień w Array(),Intersect(), Worksheets(), PivotFields()

Tabela przestawna 1
Tabela przestawna 2
Tabela przestawna 3
Tabela przestawna 4
H1
Nazwa arkusza
Nazwa pola




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
Ten komentarz został zminimalizowany przez moderatora na stronie
Как сделать чтобы сводная таблица применяла сразу 2 фильтра из 2хразных ячеек? а не 1 как в примере?
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Aleksei,

Sprawdź, czy kod VBA w tym komentarzu #38754 może pomóc.
Ten komentarz został zminimalizowany przez moderatora na stronie
Можно ли сослаться вместо ячейки H6 на ячейку на другом листе? как это сделать? подскажите пожалуйста.
Ten komentarz został zminimalizowany przez moderatora na stronie
Cześć Aleksei,

Nie musisz modyfikować kodu, wystarczy dodać kod VBA do arkusza roboczego komórki, do której chcesz się odwołać.
Na przykład, jeśli chcesz przefiltrować tabelę przestawną o nazwie „Tabela przestawna 1„w Sheet2 na podstawie wartości komórki H6 in Sheet3, kliknij prawym przyciskiem myszy Sheet3 kartę arkusza, kliknij Wyświetl kod z menu po kliknięciu prawym przyciskiem myszy, a następnie dodaj kod do pliku Arkusz3 (Kod) okno.
Nie ma tu jeszcze żadnych komentarzy
Zostaw swój komentarz
Publikowanie jako gość
×
Oceń ten post:
0   Postacie
Sugerowane lokalizacje

Bądż na bieżąco

Prawa autorskie © 2009 - www.extendoffice.com. | Wszelkie prawa zastrzeżone. Zasilany przez ExtendOffice, | Mapa strony
Microsoft i logo Office są znakami towarowymi lub zastrzeżonymi znakami towarowymi Microsoft Corporation w Stanach Zjednoczonych i / lub innych krajach.
Chronione przez Sectigo SSL