Přejít k hlavnímu obsahu

Jak udržet posuvník kontingenční tabulky v pohybu pomocí posouvání listu v aplikaci Excel?

Při práci s kontingenční tabulkou můžete vložit průřezy pro vizuální filtrování dat tabulky. Tento článek hovoří o udržování průřezu kontingenční tabulky vždy viditelném při posouvání listu.

Udržujte posuvník kontingenční tabulky v pohybu pomocí posouvání listu pomocí kódu VBA


Udržujte posuvník kontingenční tabulky v pohybu pomocí posouvání listu pomocí kódu VBA

Následující skript VBA vám pomůže udržet průřez kontingenční tabulky v pohybu s listem. Postupujte prosím následovně.

1. zmáčkni Další + F11 současně otevřete Microsoft Visual Basic pro aplikace okno.

2. V Microsoft Visual Basic pro aplikace okno, dvakrát klikněte Tato pracovní kniha v levém podokně projektu a poté zkopírujte a vložte níže uvedený kód VBA do Tento sešit (kód) okno. Viz snímek obrazovky:

Kód VBA: Udržujte posuvník kontingenční tabulky v pohybu pomocí posouvání listu

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ShF As Shape
    Dim ShM As Shape
    'specify a slicer
    Application.ScreenUpdating = False
    Set ShF = ActiveSheet.Shapes("Column1")
    Set ShM = ActiveSheet.Shapes("Column2")
    'change position of the slicer
    With Windows(1).VisibleRange.Cells(1, 1)
        ShF.Top = .Top
        ShF.Left = .Left + 300
        ShM.Top = .Top
        ShM.Left = .Left + 100
    End With
    Application.ScreenUpdating = True
End Sub

Poznámky:

1). V kódu jsou sloupce1 a sloupce2 názvy průřezů.

2). Při posouvání listu v kódu můžete určit polohu průřezů.

3). A do kódu můžete přidat další průřezy nebo z něj průřezy odstranit, jak potřebujete.

3. zmáčkni Další + Q klávesy pro zavření Microsoft Visual Basic pro aplikace dialogové okno.

Od této chvíle budou zadané průřezy přesunuty s aktivní buňkou při posouvání listu. Viz screenshot:


Související články:

Nejlepší nástroje pro produktivitu v kanceláři

🤖 Kutools AI asistent: Revoluční analýza dat založená na: Inteligentní provedení   |  Generovat kód  |  Vytvořte vlastní vzorce  |  Analyzujte data a generujte grafy  |  Vyvolejte funkce Kutools...
Populární funkce: Najít, zvýraznit nebo identifikovat duplikáty   |  Odstranit prázdné řádky   |  Kombinujte sloupce nebo buňky bez ztráty dat   |   Kolo bez vzorce ...
Super vyhledávání: Více kritérií VLookup    VLookup s více hodnotami  |   VLookup na více listech   |   Fuzzy vyhledávání ....
Pokročilý rozevírací seznam: Rychle vytvořte rozevírací seznam   |  Závislý rozbalovací seznam   |  Vícenásobný výběr rozevíracího seznamu ....
Správce sloupců: Přidejte konkrétní počet sloupců  |  Přesunout sloupce  |  Přepnout stav viditelnosti skrytých sloupců  |  Porovnejte rozsahy a sloupce ...
Doporučené funkce: Zaměření mřížky   |  Návrhové zobrazení   |   Velký Formula Bar    Správce sešitů a listů   |  Knihovna zdrojů (Automatický text)   |  Výběr data   |  Zkombinujte pracovní listy   |  Šifrovat/dešifrovat buňky    Odesílat e-maily podle seznamu   |  Super filtr   |   Speciální filtr (filtr tučné/kurzíva/přeškrtnuté...) ...
Top 15 sad nástrojů12 Text Tools (doplnit text, Odebrat znaky, ...)   |   50+ Graf Typ nemovitosti (Ganttův diagram, ...)   |   40+ Praktické Vzorce (Vypočítejte věk na základě narozenin, ...)   |   19 Vložení Tools (Vložte QR kód, Vložit obrázek z cesty, ...)   |   12 Konverze Tools (Čísla na slova, Přepočet měny, ...)   |   7 Sloučit a rozdělit Tools (Pokročilé kombinování řádků, Rozdělit buňky, ...)   |   ... a více

Rozšiřte své dovednosti Excel pomocí Kutools pro Excel a zažijte efektivitu jako nikdy předtím. Kutools for Excel nabízí více než 300 pokročilých funkcí pro zvýšení produktivity a úsporu času.  Kliknutím sem získáte funkci, kterou nejvíce potřebujete...

Popis


Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!
Comments (10)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Okay, so the title says "How To Keep Slicer Of Pivot Table Moving With Worksheet Scrolling In Excel?", but this VBA code only does it for the current selected cell, how can we do it for the scrolling of the workbook, and not just the selected cell?
This comment was minimized by the moderator on the site
I have 4 slicers which have been grouped together by selecting all 4 and the right clicking to use the group command.

Is it possible to assign this VBA by a group? How do you label the group and write the VBA to recognize it as one?
This comment was minimized by the moderator on the site
Hi Michael,
Sorry can't help with this. Thanks for your comment.
This comment was minimized by the moderator on the site
What does the first row indicate and how do we customize it to suit our slicer?
I'm very confused about that on basically every line.
This comment was minimized by the moderator on the site
Dear Katie
I don't know if I totally understand your question.
As I mentioned in above Notes, you need to replace Column1 and Column2 with the names of your slicers in the code in order to keep your slicer scrolling with the worksheet.
This comment was minimized by the moderator on the site
Hi,
Thank you for this VBA.

I have absolutely no idea about VBA and hence my question.

I used this VBA and I had a question.
How can i alter this VBA so that it works only for one sheet.

Right now, I have 8 sheets and every time i go to another sheet, it fails and asks me to end or debug.
I have done exactly the way as shown above.


This is my VBA here..
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim ShF As Shape
Dim ShM As Shape
'specify a slicer
Application.ScreenUpdating = False
Set ShF = ActiveSheet.Shapes("Client 1")
Set ShM = ActiveSheet.Shapes("Reminder 1")
'change position of the slicer
With Windows(1).VisibleRange.Cells(1, 1)
ShF.Top = .Top + 2
ShF.Left = .Left + 475
ShM.Top = .Top + 180
ShM.Left = .Left + 475
End With
Application.ScreenUpdating = True
End Sub


Please help.
This comment was minimized by the moderator on the site
Dear John,
Shift to the worksheet you want the VBA code only work for, then right click the Sheet tab and select View Code from the context menu.
And then copy and paste below VBA code into the opening Code window. See below screenshot:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ShF As Shape
Dim ShM As Shape
'specify a slicer
Application.ScreenUpdating = False
Set ShF = ActiveSheet.Shapes("Fruit")
Set ShM = ActiveSheet.Shapes("Sale")
'change position of the slicer
With Windows(1).VisibleRange.Cells(1, 1)
ShF.Top = .Top
ShF.Left = .Left + 300
ShM.Top = .Top
ShM.Left = .Left + 100
End With
Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
Hi,I have updated my code as you have indicated. The slicer no longer scrolls along with the window however if I click in a new cell then the slicer will move. Is this the correct behavior?
This comment was minimized by the moderator on the site
Dear Crystal,

Thank you so very much for the code.
I did exactly as you said and it works like a charm.

Really appreciate it.
Cheers :)
This comment was minimized by the moderator on the site
Hi,
Thank you for this VBA.

I have absolutely no idea about VBA and hence my question.

I used this VBA and I had a question.
How can i alter this VBA so that it works only for one sheet.

Right now, I have 8 sheets and every time i go to another sheet, it fails and asks me to end or debug.
I have done exactly the way as shown above.


This is my VBA here..
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim ShF As Shape
Dim ShM As Shape
'specify a slicer
Application.ScreenUpdating = False
Set ShF = ActiveSheet.Shapes("Client 1")
Set ShM = ActiveSheet.Shapes("Reminder 1")
'change position of the slicer
With Windows(1).VisibleRange.Cells(1, 1)
ShF.Top = .Top + 2
ShF.Left = .Left + 475
ShM.Top = .Top + 180
ShM.Left = .Left + 475
End With
Application.ScreenUpdating = True
End Sub


Please help.
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations