Přeskočit navigaci | Přeskočit na novinky
     

Jste zde: Úvodní stránka » excel » VBA-kontingencni-tabulka » excel-vba-kontingencni-tabulka
Microsoft Excel logo

Kontingenční tabulky - VBA Excel

Videokurzy Excel

Ve spolupráci se SEDUO jsem vytvořil několik videokurzů:

Tvoříte kontingenční tabulky pomocí VBA? Nechce se vám stále hledat VBA kódy? Osobně se mi také nechtělo. Proto jsem vytvořil tento Mega přehled kódu pro práci s kontingenčními tabulkami (budu ještě dále doplňovat a rozšiřovat dle svých aktuáních potřeb). Třeba se vám bude také hodit.

Úvodem aneb seznam kódu

Pro přehlednost je článek rozdělen na jednotlivé kapitoly ať nemusíte kódy složitě lovit, jen vyberete ten který potřebujete:


Tvorba Kontingenční tabulky

Vytvoření kontingenční tabulky na novém listě, který si vytvoříte a pojmenujete. Stejně jako kontingenční tabulku, na kteoru se následně budeme odvolávat jejím názvem.

' ----------------------------------------------------------- ' - Tvorba Kontingenční tabulky vužitím VBA (Pivot Table VBA) ' ----------------------------------------------------------- .Dim ListProKT As Worksheet Dim PivotkaCache As PivotCache Dim Pivotka As PivotTable Dim PivotkaStart As String Dim PivotkaData As String ' Data ze kterých se vytvoří KT PivotkaData = ActiveSheet.Name & "!" & Range("A1:I52").Address(ReferenceStyle:=xlR1C1) ' ' bude na jiném listě ' ' v přípravě ' ' bude pojmenovaná oblast ' ' v přípravě ' Nový sešit do kterého příjde KT, nekontroluje, zda existuje Set ListProKT = Sheets.Add ' list s KT si pojmenuji, budu pak odkazovat ListProKT.Name = "KT2" ' ' přidát list na konec ' Set ListProKT = ThisWorkbook.Sheets.Add(After:= ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ' Od které pozice se bude KT tvořit (klasicky od A3) PivotkaStart = ListProKT.Name & "!" & ListProKT.Range("A3").Address(ReferenceStyle:=xlR1C1) ' Vytvořit Cache pro kontingenční tabulku (Pivot Table) Cache ze zdrojových dat Set PivotkaCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotkaData) ' Vytvoření kontingenčky z cache, pod jménem at se lze odkazovat Set Pivotka = PivotkaCache.CreatePivotTable(TableDestination:=PivotkaStart, TableName:="Pivot2")

Pokud jde o aktuální list, tabulka je jako tabulka ...

V přípravě

Smazat kontingenční tabulku na základě jejího názvu

V listu KT2

' --------------- ' -- Smazat kontingenční tabulku na základě jejího názvu ' --------------- Sheets("KT2").PivotTables("Pivot2").TableRange2.Clear

V aktivním sešitě

' Smazat na aktivním listě ActiveSheet.PivotTables("Pivot2").TableRange2.Clear

Smazat všechny KT

Smazaní všech kontingenčních tabulek. Inspirace na stackoverflow.com

WS As Worksheet PT As PivotTable If MsgBox("Smazat všechny kontingenční tabulky v aktivním sešitě?", _ vbYesNo + vbDefaultButton2, "Vše smazat?") = vbNo Then Exit Sub On Error Resume Next For Each WS In ActiveWorkbook.Worksheets For Each PT In WS.PivotTables WS.Range(PT.TableRange2.Address).Delete Shift:=xlUp Next PT Next WS

Přepočet kontingenční tabulky

Přepočet kontingenční tabulky na listtu KT2

'Přepočet KT Sheets("KT2").PivotTables("Pivot2").PivotCache.Refresh

Přepočet kontingenční tabulky na aktivním listu

'Přepočet aktivní list ActiveSheet.PivotTables("Pivot2").PivotCache.Refresh

Přepočet všechny kontingenční tabulky

'Refresh všechny pivotky ActiveWorkbook.RefreshAll

Přidat řádkové oblasti do KT

Vkládaní řádkové oblasti do listu pod názvem KT2 a do kontingenční tabulky pod názvem Pivot2.

' ---- Přidat řádkové oblasti do KT Dim Pivotka As PivotTable 'Sheets("KT2").Activate Set Pivotka = Sheets("KT2").PivotTables("Pivot2") Pivotka.PivotFields("Jmeno").Orientation = xlRowField

Vložení pole do řádkové oblasti kontingenční tabulky a umístění na první místo

Sheets("KT2").Select With ActiveSheet.PivotTables("Pivot2").PivotFields("Země") .Orientation = xlRowField .Position = 1 End With

Přidání dalšího pole a umístění na požadaované pořadí:

' uspořádaní pořadí Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") Pivotka.PivotFields("DruhSportu").Orientation = xlRowField 'přehodit pozici Pivotka.PivotFields("DruhSportu").Position = 1

Odstranění pole z oblasti

Jak odstranit požadované pole z řádkové oblasti v kontingenční tabulce v aktivním sešitě:

ActiveSheet.PivotTables("Pivot2").PivotFields("Jmeno").Orientation = xlHidden

na listě se jménem KT2:

Sheets("KT2").PivotTables("Pivot2").PivotFields("Země").Orientation = xlHidden

Úpravy a formátování hodnot v řádku

V přípravě

Jak na sloupcovou oblast v KT

Jak přidávat / mazat a upravovat sloupce v kontingenční tabulce: Pro přidání:

' sloupce v KT Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") Pivotka.PivotFields("Země").Orientation = xlColumnField

Přidání a změna pozice:

Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") Pivotka.PivotFields("Země").Orientation = xlColumnField 'přehodit pozici Pivotka.PivotFields("Země").Position = 1

Pro smazání

' Stejné jako u řádku Excel nerozlišuje Sheets("KT2").PivotTables("Pivot2").PivotFields("Země").Orientation = xlHidden

Úprava formátu v přípravě

Oblast filtry v kontingenční tabulce

Jak vkládat pole do oblastí filtru v kontingenční tabulce:

' Filtry v kontingenční tabulce Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") Pivotka.PivotFields("Jmeno").Orientation = xlPageField

Odstranit pole z filtr

Sheets("KT2").PivotTables("Pivot2").PivotFields("Jmeno").Orientation = xlHidden

Filtry a multifiltry

Základní filtr v oblasti filtry.

Dim PivotkaFiltr As PivotField ' Pole Rok v oblasti filtr v pivotce (je už umístěno) Set PivotkaFiltr = Sheets("KT2").PivotTables("Pivot2").PivotFields("Rok") ' pro jistotu vymažu PivotkaFiltr.ClearAllFilters 'Filter pro rok 2010 PivotkaFiltr.CurrentPage = "2010"

Zrušení filtrů (smazání):

Dim PivotkaFiltr As PivotField Set PivotkaFiltr = Sheets("KT2").PivotTables("Pivot2").PivotFields("Rok") 'Smaž filtry pro Rok PivotkaFiltr.ClearAllFilters

Nastavení multifiltrů:

Dim PivotkaFiltr As PivotField Set PivotkaFiltr = Sheets("KT2").PivotTables("Pivot2").PivotFields("Rok") PivotkaFiltr.ClearAllFilters PivotkaFiltr.EnableMultiplePageItems = True ' co nechci vidět PivotkaFiltr.PivotItems("2008").Visible = False PivotkaFiltr.PivotItems("2010").Visible = False PivotkaFiltr.PivotItems("2011").Visible = False

Oblast hodnoty v kontingenční tabulce

Přidaní součtu do pole kontingenční tabulky:

'--------------------- ' KT oblast hodnoty '--------------------- Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") 'musím kontrolovat zda (ne)existuje název Pivotka.AddDataField Pivotka.PivotFields("Zisk"), "Součet z Zisk", xlSum

Jak na vložení počtu

'počet Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") Pivotka.AddDataField Pivotka.PivotFields("Zisk"), "Počet z Zisk", xlCount

Jak na vložení min, max ... v přípravě

Odstranění pole z oblasti hodnoty

Odstranění pole z oblasti hodnoty v kontingenční tabulce:

With Sheets("KT2").PivotTables("Pivot2").DataFields("Součet z Zisk") .Parent.PivotItems(.Name).Visible = False End With

Odstranění verze 2. Inspirace na internetu:

Dim pvt As PivotTable Dim pf As PivotField Dim pi As PivotItem Set pvt = Sheets("KT2").PivotTables("Pivot2") 'Ulož do proměné pole pod názvem For Each pf In pvt.DataFields If pf.SourceName = "Zisk" Then Exit For Next 'Odstraň počitatelné pole pf.DataRange.Cells(1, 1).PivotItem.Visible = False

Sbalit pole List KT2

Dim PivotkaPole As PivotField Set PivotkaPole = Sheets("KT2").PivotTables("Pivot2").PivotFields("Rok") 'sbalit musím mít rok měsíc PivotkaPole.ShowDetail = False

Sbalit pole aktivní list

Dim PivotkaPole As PivotField ' pro aktivní list Set PivotkaPole = ActiveSheet.PivotTables("Pivot2").PivotFields("Rok") PivotkaPole.ShowDetail = False

Rozbalit data poli v oblasti KT:

Dim PivotkaPole As PivotField Set PivotkaPole = Sheets("KT2").PivotTables("Pivot2").PivotFields("Rok") 'rozbalit PivotkaPole.ShowDetail = True

Design oblasti hodnoty v KT

Jak na design oblasti hodnot v hontingenční tabulce:

' ---------------- ' pivotka design oblast hodnoty ' ----------------- ' Poznámka: Více položek v poli hodnoty Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") ' Formát čísel Pivotka.DataBodyRange.NumberFormat = "#,##0;(#,##0)" ' Barva pozadí Pivotka.DataBodyRange.Interior.Color = RGB(200, 200, 200) ' Typ fontu Pivotka.DataBodyRange.Font.FontStyle = "Arial" ' Barva fontu ' .... ' ....

Další ukázky v přípravě

Design oblasti řádky

Jak na design oblasti řádků:

' Set pf = ActiveSheet.PivotTables("Pivot1").PivotFields("Rok") Set PivotkaPole = Sheets("KT2").PivotTables("Pivot2").PivotFields("Mesic") 'Change Data's Number Format PivotkaPole.DataRange.NumberFormat = "###0" 'Change Data's Fill Color PivotkaPole.DataRange.Interior.Color = RGB(150, 100, 241) ' Barva fontu ' .... ' ....

Další kódy v přípravě

Design oblasti sloupce

V přípravě

Celkové součty

Vypnout souhrny pro řádky i sloupce:

' ---------------------- ' Souhrny / celkové součty / Total Vypnutí ' ---------------------- Dim Pivotka As PivotTable ' 'Aktivní list Set Pivotka = Sheets("KT2").PivotTables("Pivot2") ' Vypnout pro řádky a sloupce Pivotka.ColumnGrand = False Pivotka.RowGrand = False

Zapnut souhrny pro řádky i sloupce:

' ---------------------- ' Souhrny / celkové součty / Total Zapnutí ' ---------------------- Dim Pivotka As PivotTable ' 'Aktivní list ' 'v přípravě Set Pivotka = Sheets("KT2").PivotTables("Pivot2") ' Zapnout pro řádky a sloupce Pivotka.ColumnGrand = True Pivotka.RowGrand = True

Rozložení sestavy

Kompaktně

Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") 'Rozložení sestavy - Kompaktně Pivotka.RowAxisLayout xlCompactRow

Tabulkově

Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") 'Rozložení sestavy - Zobraz tabulkově Pivotka.RowAxisLayout xlTabularRow

Osnova

Dim Pivotka As PivotTable Set Pivotka = Sheets("KT2").PivotTables("Pivot2") ' Rozložení sestavy - Osnova Pivotka.RowAxisLayout xlOutlineRow

Závěrem

Článek si neklade za cíl být kompletní příručkou, potřeboval jsem se sumarizovat kódy týkající se kontingenčních tabulek na jednom místě. Článek budu postupně doplňovat a rozšiřovat. Primárně na základě svých potřeb ;).

Článek byl aktualizován: 05.11.2016 16:37

Odměna

Ušetřil vám tento web čas, peníze? Pomohl vyřešit problém? Jste ochotni poskytnout symbolickou odměnu na další rozvoj? Vybrte si formu odměny, která vám vyhovuje.


Pavel Lasák - autor webu

Pavel Lasák

Microsoft Office (Word, Excel, Google tabulky, PowerPoint) se věnuji od roku 2000 (od 2004 na této doméně) - V roce 2017 jsem od Microsoft získal prestižní ocenění MVP (zatím jsem jediný z ČR v kategorií Excel). Své vědomosti a zkušenosti dávám k dispozici i on-line ve videích pro SEDUO. Ve firmách školím a konzultuji, učím na MUNI. Tento web již tvořím přes 15 let. Zdarma je zde přes 1.000 návodu, tipů a triků, včetně přes 250 různých šablon, sešitů.

   Pavel Lasák LinkedIn Profil    Pavel Lasák Google+ Profil    Pavel Lasák facebook Profil    Pavel Lasák twitter Profil


Komentáře


Jakub

Přidáno: 01.12.16 13:17

Dobrý den, jaký parametr musím nastavit místo xlCount, když chci zobrazit v Oblasti hodnot počet procent z řádku? Pivotka.AddDataField Pivotka.PivotFields("Zisk"), "Počet z Zisk", xlCount Děkuji za odpověď







Sdílejte

Pomohl Vám návod?
Sdílejte na Facebooku, G+
LinkedIn...

Nové články


TOPlist Licence Creative Commons webarchiv rss XML

Stránky o MS Office (Excel) produktu společnosti Microsoft. Neslouží jako technická podpora.
| Email na autora: pavel.lasak@gmail.com | Copyright © : Pavel Lasák 2004 - 2018 | 4883

Tento web zatím neprošel jazykovou korekturou. Beta verze redakčního systému.