Automatizujeme report pomocou kontingenčnej tabuľky

 

Kontingenčné tabuľky v Exceli sú v praxi bežná užívateľská pomôcka, ktorej tvorbu a ovládanie som vysvetlil v jednom z prvých článkov tohto blogu.

Predstavte si situáciu, kedy pravidelne musíte z dataset-u urobiť kontingenčnú tabuľku(y) v štandardnom výstupe, s jediným rozdielom v názve alebo mesiaci, poprípade roka. Na prvý pohľad triviálna vec, ale po čase začne popri dôležitejšej práci liezť na nervy každému analytikovi.

Našťastie aj takýto report môžeme efektívne automatizovať. Celkovo potrebujeme nahrať makro na tvorbu kontingenčnej tabuľky, v ktorom upravíme dva základné atribúty: Dátový zdroj a  Názov.

Celý proces bude prebiehať nasledovne:

1) Skopíruje sa štandardný list DATA na špecifický Sales Summary „Rok“ „Mesiac“

2) V tomto liste sa nadefinuje oblasť pre kontingenčnú tabuľku RNG_“Mesiac“_“rok“

3) Vytvorí sa štandardná kontingenčná tabuľka pod názvom SALES_PIVOT_“Mesiac“ „Rok“

4) Procedúra nás upozorní, že daný prehľad sa vytvoril, poprípade že už existuje

Prejdime k prvému bodu, pre ktorý kód bude vyzerať takto:

Sub Procedura()

Sheets("DATA").Copy Before:=Sheets("DATA")

On Error GoTo koniec

ActiveSheet.Name = "Sales Summary " & Mesiac & " " & Rok

‘======== zvyšná časť kódu ===================================

koniec:

Application.DisplayAlerts = False

ActiveSheet.Delete

Application.DisplayAlerts = True

MsgBox "Prehľad za " & Mesiac & "_" & Rok & " už existuje", vbCritical

End Sub

Táto procedúra v sebe obsahuje ošetrenie, ktoré v prípade že takýto list existuje – vymaže už skopírovaný list DATA(2) a ukončí celé makro, viď časť kódu za časťou koniec:.

Než začneme s nahrávaním, pripravíme si dve premenné – Mesiac a Rok, ktoré budú načítavať hodnoty z buniek v aktuálnom liste.

Dim Mesiac As Integer

Dim Rok As Integer

Mesiac = ActiveSheet.Cells(10, 10)

Rok = ActiveSheet.Cells(8, 10)

Potom si vytvoríme procedúru, ktorá pripraví špecifickú pomenovanú oblasť pre kontingenčnú tabuľku s názvom RNG_“mesiac“_“rok“

ActiveSheet.Names.Add Name:="RNG_" & Mesiac & "_" & Rok, RefersTo:= _

Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5))

Táto RNG oblasť nám bude slúžiť ako vstupný zdroj pre tvorbu kontingenčnej tabuľky. Napokon nám stačí nahrať tvorbu špecifickej tabuľky so štandardnými popismi stĺpcov a riadkov.

V samotnej tvorbe tabuľky kód po úprave vyzerá takto (pozn. červenou farbou sú označené zmeny atribútov nahraného kódu, pričom PivotStyle časť som úplne vymazal):

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"RNG_" & Mesiac & "_" & Rok).CreatePivotTable TableDestination:= _

ActiveSheet.Cells(15, 9), TableName:="SALES_PIVOT_" & Mesiac & " " & Rok

Dohodíme kód pre úpravu vzhľadu – použijem jeden z štandardných dizajnov tabuľky:

ActiveSheet.PivotTables( "SALES_PIVOT_" & Mesiac & " " & Rok).TableStyle2 = "PivotStyleDark4"

V tomto štádiu stačí pridať stĺpce (Sales Executive), riadky (Group) a telo (Price) tabuľky + upraviť formát čísel:

With ActiveSheet.PivotTables("SALES_PIVOT_" & Mesiac & " " & Rok).PivotFields( _

"Sales Executive")

.Orientation = xlColumnField

.Position = 1

End With

With ActiveSheet.PivotTables("SALES_PIVOT_" & Mesiac & " " & Rok).PivotFields("Group")

.Orientation = xlRowField

.Position = 1

End With

ActiveSheet.PivotTables("SALES_PIVOT_" & Mesiac & " " & Rok).AddDataField ActiveSheet. _

PivotTables("SALES_PIVOT_" & Mesiac & " " & Rok).PivotFields("Price"), _

"Total Revenues", xlSum

With ActiveSheet.PivotTables("SALES_PIVOT_" & Mesiac & " " & Rok).PivotFields( _

"Total Revenues")

.NumberFormat = "# ##0"

End With

Range("A1").Select

Nakoniec dodáme message box, ktorý nám oznámi ukončenú procedúru, vymaže tlačidlo pre tvorbu prehľadu a ukončí makro pred oblasťou koniec: :

ActiveSheet.Buttons.Delete

MsgBox "Prehľad za " & Mesiac & "_" & Rok & " bol vytvorený", vbExclamation

Exit Sub

Posledný detail, ktorý ma napadol je, že by nebolo na škodu v podkladovom liste DATA nechať vstupy zmazať pre budúce použitie. Tým pádom stačí do posledného kódu hneď za metódu delete pridať:

Sheets("DATA").Select

Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 5)).Clear

sheets("Sales Summary " & Mesiac & " " & Rok).Select

Takto vytvorená procedúrka v nasleduúcom template bude vo finále vyzerať takto:

Teda: prehľad za obdobie Apríl roku 2014 je v špecifickom liste a zároveň nás message box upozornil, že prehľad je vytvorený. List DATA je samozrejme vyprádznený, viď nasledujúci obrázok:

A ak by sme do DATA listu nakopírovali hodnoty a chceli opäť uložiť pod rovnakým názvom, objaví sa nesledujúca hláška:

Ako je už zvykom, celý template spolu s kódom je k dispozícii – stačí kliknúť na obrázok Download, ak by ste mali akýkoľvek dotaz – navštívte facebookovskú skupinu – klikni na modré logo .