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 .

Meníme odkazy v bunkách (Doláre - $$ mezi písmenkami a číslami) vo vzorcoch

 

V praxi sa častokrát stáva, že vytvoríte istý štandardný výstup a nechcete aby Vám niektorý z proaktívnych nešťastníkov omylom pozmenil vzorce. Niekedy sa to Bohužiaľ stáva aj samotnéhmu analytikovi (môj prípad ^_^ ) .

Z toho dôvodu, ak máte všetko navzorčekované správne si môžete pozmeniť odkazy buniek takto:

Prejdime ku kódu:

Sub Konverzia()

Dim RNG As Range
Dim c
Dim T As Integer

'======================Definujeme typ ukotvenia===========================
T = Application.InputBox("Ako si chcete zafixovať danú bunku?" & vbCrLf & vbCrLf & _
Chr(9) & "Pre $A$1 zvoľte 1" & vbCrLf & _
Chr(9) & "Pre A1 zvoľte 2" & vbCrLf & _
Chr(9) & "Pre $A1 zvoľte 3" & vbCrLf & _
Chr(9) & "Pre A$1 zvoľte 4", "Typ ukotvenia", 1, , , , , 1)

'=============Definujeme oblasť, ktorú chceme ukotviť===========================
Set RNG = Application.InputBox("Definujte oblasť, v ktorej chcete ukotviť bunky vo vzorcoch", _
"Znema vzorcov", , , , , , 8).SpecialCells(Type:=xlFormulas)

'======================ukotvujeme oblasť===========================
For Each c In RNG
    If c.HasFormula Then
        If Len(c.FormulaArray) < 255 Then
            Select Case T

                Case 1
                    c.FormulaArray = Application.ConvertFormula(Formula:=c.Formula, _
                    FromReferenceStyle:=xlA1, _
                    ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsolute)
                Case 2
                    c.FormulaArray = Application.ConvertFormula(Formula:=c.Formula, _
                    FromReferenceStyle:=xlA1, _
                    ToReferenceStyle:=xlA1, ToAbsolute:=xlRelative)
                Case 3
                    c.FormulaArray = Application.ConvertFormula(Formula:=c.Formula, _
                    FromReferenceStyle:=xlA1, _
                    ToReferenceStyle:=xlA1, ToAbsolute:=xlAbsRowRelColumn)
                Case 4
                    c.FormulaArray = Application.ConvertFormula(Formula:=c.Formula, _
                    FromReferenceStyle:=xlA1, _
                    ToReferenceStyle:=xlA1, ToAbsolute:=xlRelRowAbsColumn)
                Case Else
                    MsgBox "Nezvolili ste správny typ ukotvenia", vbCritical
                    Exit Sub
       
                End Select
           
        End If
    End If
Next c

End Sub

Avšak obmedzujúcou podmienkou použitia procedúry Application.ConvertFormula je maximálny počet znakov v bunke, ktorý nepresahuje počet 255. Kliknutím na možnosť Download si stiahnete template súbor, kde som prirpavil ukážku vzorcov a dané marko. V prípade dotazov sa neváhajte opýtať na Facebook-u .

 

           

Exportujeme data z reportu do databázy MySQL (ošetrujeme duplicity)

 

V predchádzajcom článku som sa podrobne venoval problematike nastavenia databázy v MySQL a zároveň ukázal, ako cez VBA sa pripojiť a zároveň vložiť data z tabuľky. Avšak v tomto prípade sa nebudem zaoberať otázkou vhodnosti ošetrenia duplicít, prejdem priamo k riešeniu.

V predchádzajúcom článku sme si pomociu SQL dotazu vytvorili tabuľku s názvom tab, ktorá sa skladala len z dvoch premenných – Meno a Priezvisko.

Túto tabuľku, predtým než začneme si musíme tak trochu upraviť na nasledujúci tvar (pridať stĺpec ID – číselné hodnoty).

Túto úpravu realizujeme nasledujúcim kódom v MySQL command: ALTER TABLE TAB ADD COLUMN ID INT; Ak si všimnene nový stĺpec ID, vidíme že pre každého užívateľa hodnotu NULL, t.z. že predchádzajúce záznamy nemali vložený atribút ID.

Vymažme staré záznamy príkazom v MySQL command: DELETE FROM tab; získame tak úplne prázdnu tabuľku – pripravenú pre vkládanie dat.

Prejdeme do Excel prostredia a v liste s názvom DATA si pripravme tabuľku s hodnotami:

Potom pomocou záložky DEVELOPER si pripravte tlačítko, pomocou ktorého budete realizovať export dat do databázy.

 

Poznámka: toto tlačítko vrátane formátovania som pripravil pomocou ActiveX možnosti. Tým pádom ak ste v DESIGN MODE, jeho rozkliknutím sa dostanete do VBA editora kde do procedúry dopíšete názov makra na export dat:

Private Sub CMB_vlozDATA_Click()
    Call VlozData
End Sub

Teraz stačí už len vložiť modul a v ňom nadefinovať funkciu, ktorá odsráni medzery z textov a základné premenné:

Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rsc As ADODB.Recordset

Function esc(txt As String)
' Očistí text o medzery
    esc = Trim(Replace(txt, "'", "\'"))
End Function

Ďalej vložíme nasledujúce makro, ktorým sa pripojíme na databázový server (nezabudnite doplniť prihlasovacie údaje – červene označené):

Sub pripojDB()
   
'pripajanie sa na DB
    Set oConn = New ADODB.Connection
    oConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
    "SERVER=NázovServera;" & _
    "DATABASE=NázovDatabázy;" & _
    "USER=Užívateľ;" & _
    "PASSWORD=Heslo;" & _
    "Option=3"
   
End Sub

Posledné marko bude zvolávať predchádzajúce a bude sa skladať z dvoch stringových premenných, ktorými sú MySQL query na overenie prítomnosti duplicity:

SELECT COUNT(ID) AS idpocet FROM tab WHERE ID=’1’

Druhý MySQL query vkladá jednotlivé riadky ako záznamy do DB:

INSERT INTO tab (Meno, Priezvisko, ID) VALUES (‘Peter’,’Tabiš’,’1’);

Procedúra je ošetrená tak, že ak sa výsledok prvého query – teda idpocet nerovná nule, tak sa prenesie na ďalší riadok a v duplicitnom označí červenou farbou bunku v ID stĺpci. VBA riešenie vyzerá nasledovne:

Sub VlozData()

On Error GoTo Koniec
Dim Data As Worksheet
Dim SQLkod As String
Dim riadok As Integer
Dim duplicita As Integer

'Nastaví list so vstupnými datami
Set Data = Worksheets("Data")
Set rs = New ADODB.Recordset 
Set rsc = New ADODB.Recordset
riadok = 2
dupicita = 0
           
'Pripojí sa na server
pripojDB
   
    With Data
        While Trim(.Cells(riadok, 1)) <> "" 'pokračuj pokial 'did' bunky sú neprázdne
           
           'Ak je recordset pre ovedenie duplicit aktívny, tak ho zavrie
            If rsc.State = adStateOpen Then
                rsc.Close
            End If
            'Definícia query pre MySQL - ako overiť, či sa záznam nachádza v DB
            SQLkod = "SELECT COUNT(ID) AS idpocet FROM tab WHERE ID='" & Trim(.Cells(riadok, 3)) & "'"
           'Obnovenie recordsetu rsc - zistíme či sa záznam nachádza v DB - výstup je premenná "idcount"
            rsc.Open SQLkod, oConn, adOpenStatic, adLockOptimistic
           
            'Označí rsc za aktuálny
            rsc.MoveFirst
           
           'Ak sa dané ID nachádza v DB, vyfarbí ID bunku červenou farbou a zaznamená počet duplicít
            If rsc.Fields("idpocet") > 0 Then
                .Cells(riadok, 3).Interior.Color = RGB(255, 0, 0)
                dupicita = dupicita + 1
                GoTo SkipInsert
            End If
            'zavrie počítací recordset
            rsc.Close

            ' Definícia query pre MySQL - Ako vložiť riadok, teda záznam
            SQLkod = "INSERT INTO tab (Meno, Priezvisko, ID) " & _
            "VALUES ('" & esc(Trim(.Cells(riadok, 1).Value)) & "', '" & _
            esc(Trim(.Cells(riadok, 2).Value)) & "', '" & _
            esc(Trim(.Cells(riadok, 3).Value)) & "')"
           
            'Ak je recordset pre vklad dát aktívny, tak ho zavrie
            If rs.State = 1 Then
                rs.Close
            End If
            'Obnovenie recordsetu rs - vložíme riadok / záznam
            rs.Open SQLkod, oConn, adOpenDynamic, adLockOptimistic
SkipInsert:
            riadok = riadok + 1
        Wend
        .Select
    End With
   
    MsgBox "Počet celkových vložených riadkov je: " & riadok - 2 - dupicita & vbCrLf & " - červené bunky v liste Data sú duplicitné hodnoty", vbInformation, "DB výsledok"

Koniec:
'Chybové hlásenie
    If Err.Description <> "" And Err.Source <> "" Then
        MsgBox Err.Description, vbCritical, Err.Source
    End If
End Sub

Výsledok si overíme tak, že po kliknutí sa nám objaví nasledujúca hláška:

A dáta sa budú nachádzať v MySQL:

Ak by sme chceli vložiť tie isté data ešte raz, po kliknutí sa objaví nasledujúca hláška a duplicitné riadky sa nám sfarbia na červeno:

Samotná tabuľka v MySQL ostane nezmenená. V konečnom dôsledku si môžete nastaviť rôzne spôsoby overenia dát. No predtým než ich vložíte do databázy, vo väčšine prípadov nie je potrebné neustále s ňou komunikovať. Dôležité je nastaviť procedúru tak, aby pripájaním zbytočne nezahlcovala server.

V prípade dotazov alebo rady som k dispozícii na FB – stačí kliknúť na nasledujúce Excel logo