Úvod Bleskovky Články Případovky O Sunu Taste Sun

Usnadněte si práci se sortiment reportem

Digichef

Určitě si pravidelně prohlížíte sortiment report z Heuréky, abyste mohli sledovat, které kategorie produktu jsou nejpopulárnější, a zda na tyto kategorie a produkty zaujímáte dostatečně vysoké pozice z hlediska ceny i biddingu. Před Vánoci si sortiment report nejspíš prohlížíte každý den a už vás určitě nebaví dělat pořád dokola ty samé úkony, nastavovat stejné filtry a kontingenční tabulky. Proto by se vám mohlo líbit níže přiložené makro, které si můžete vložit do excelu a ono udělá všechnu tu rutinní práci samo během pár sekund.

Výstupem práce makra jsou 3 nové listy, přičemž na prvním (top-kat) naleznete přehled kategorií, které jsou seřazené podle průměrné popularity. Dále zde najdete údaje o průměrné pozici dle ceny a biddingu dané kategorie. Na dalším listu (top-lowpos-price) najdete TOP 30 nejoblíbenějších produktů s pozicí dle ceny nižší než 3. Na posledním listu (top-lowpos-bid) najdete totéž, ale s pozicí dle biddingu.

A jak si makro implementujete?

1) Stáhněte si Sortiment report z Heuréky, otevřete a povolte provádění změn v souboru.

2) Pro nahrání makra budete potřebovat kartu Vývojář. Tu nemáte s největší pravděpodobností viditelnou. Zprovoznit ji není nic těžkého. Nejdřív klikněte na šipku v levém horním rohu vedle rychlého přístupu. Pak klikněte na Další příkazy.

image

3) Klikněte na Přizpůsobit pás karet a zaškrtněte možnost Vývojář.

image

4) Výtečně. Kartu Vývojář máme, tak se ni půjdeme rovnou podívat.

5) Jako první ikonku vlevo na této kartě vidíme Visual Basic. Proklikněte ji. Zobrazí se vám nové rozhraní. 

 
image

6) V novém rozhraní klikněte na možnost Insert a Module. Objeví se tabulka, která vypadá jako klasický officový poznámkový blok. 

 
image

7) Do tohoto bloku vložte kód a spusťte vyznačeným tlačítkem. 

 
image

8) A je hotovo. Nemáte zač.

Samotné makro najdete zde: 


Sub sortiment_report()
'
' sortiment_report Makro
'

'
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("List1").Name = "top-lowpos-price"
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets("List2").Select
    Sheets("List2").Name = "top-lowpos-bid"
    Range("C42").Select
    Sheets("Worksheet").Select
    Columns("A:AI").Select
    Selection.Copy
    Application.CutCopyMode = False
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Worksheet!R1C1:R65536C35", Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:="List3!R3C1", TableName:="Kontingenční tabulka 1", _
        DefaultVersion:=xlPivotTableVersion10
    Sheets("List3").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Kategorie")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields( _
        "Popularita produktu na trhu")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields( _
        "Vaše pozice dle ceny")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields( _
        "Vaše pozice dle biddingu")
        .Orientation = xlRowField
        .Position = 4
    End With
    ActiveSheet.PivotTables("Kontingenční tabulka 1").AddDataField ActiveSheet. _
        PivotTables("Kontingenční tabulka 1").PivotFields("Popularita produktu na trhu" _
        ), "Počet z Popularita produktu na trhu", xlCount
    ActiveSheet.PivotTables("Kontingenční tabulka 1").AddDataField ActiveSheet. _
        PivotTables("Kontingenční tabulka 1").PivotFields("Vaše pozice dle ceny"), _
        "Počet z Vaše pozice dle ceny", xlCount
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With
    ActiveSheet.PivotTables("Kontingenční tabulka 1").AddDataField ActiveSheet. _
        PivotTables("Kontingenční tabulka 1").PivotFields("Vaše pozice dle biddingu"), _
        "Počet z Vaše pozice dle biddingu", xlCount
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields( _
        "Počet z Popularita produktu na trhu")
        .Caption = "Průměr z Popularita produktu na trhu"
        .Function = xlAverage
    End With
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields( _
        "Počet z Vaše pozice dle ceny")
        .Caption = "Průměr z Vaše pozice dle ceny"
        .Function = xlAverage
    End With
    With ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields( _
        "Počet z Vaše pozice dle biddingu")
        .Caption = "Průměr z Vaše pozice dle biddingu"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Kategorie"). _
        AutoSort xlDescending, "Průměr z Popularita produktu na trhu"
    Columns("B:D").Select
    Selection.NumberFormat = "0.00"
    Range("D4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("C4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("B4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Rows("1:3").Select
    Selection.EntireRow.Hidden = True
    ActiveWindow.SmallScroll Down:=45
    Sheets("List3").Select
    Sheets("List3").Name = "top-kat"
    Sheets("top-kat").Select
    Sheets("top-kat").Move Before:=Sheets(3)
    Sheets("Worksheet").Select
    Range("K5").Select
    ActiveWindow.SmallScroll Down:=-9
    ActiveWorkbook.Worksheets("Worksheet").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Worksheet").AutoFilter.Sort.SortFields.Add Key:= _
        Range("K1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Worksheet").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$AI$65000").AutoFilter Field:=11, Criteria1:="35", _
        Operator:=xlTop10Items
    Range("C1:C36").Select
    Selection.Copy
    Sheets("top-lowpos-price").Select
    ActiveSheet.Paste
    Sheets("Worksheet").Select
    Range("K1:K36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C2410").Select
    Sheets("top-lowpos-price").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets("Worksheet").Select
    Range("L1:M36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("top-lowpos-price").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("Worksheet").Select
    Range("H1:I36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("top-lowpos-price").Select
    Range("E1").Select
    ActiveSheet.Paste
    Columns("A:A").EntireColumn.AutoFit
    Range("A1:F1").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 1
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$F$36").AutoFilter Field:=4, Criteria1:=">3", _
        Operator:=xlAnd
    Range("A35").Select
    Sheets("Worksheet").Select
    Range("C1:C36").Select
    Selection.Copy
    Sheets("top-lowpos-bid").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Worksheet").Select
    Range("K1:K36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("top-lowpos-bid").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets("Worksheet").Select
    Range("N1:O36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("top-lowpos-bid").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("Worksheet").Select
    Range("H1:I36").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("top-lowpos-bid").Select
    Range("E1").Select
    ActiveSheet.Paste
    Range("A1:F1").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = 1
        .Color = 49407
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Columns("A:A").EntireColumn.AutoFit
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$F$36").AutoFilter Field:=3, Criteria1:=">3", _
        Operator:=xlAnd
End Sub

Neunavujte se, makro pracuje za vás.

Aňa Tomášková

  • Celkový průměr hodnocení: 5.0 z 5
  • 5.0
  • 5.0
  • 5.0
  • 5.0
  • 5.0

13. prosince 2016

K článku již nelze přidávat další komentáře.

  1. Marek | 8. března 2018

    Dobrý den.

    Je dané makro stále použitelné?
    Koukám, že článek je přeci jen starý více než rok :-)

    Vložím kód, spustím a vyskočí na mne hláška: ru-time error 9, subscript out of range. Pokud kliknu debug, označí se mi žlutě: Sheets("Worksheet").Select.

    Děkuji,
    Marek

  2. Aňa Tomášková | 16. března 2018

    Dobrý den, Marku,

    makro je stále použitelné. Vámi popsaný zádrhel spočívá v tom, že Excel neposílá po spuštění makra informační hlášku o tom, že operace byla řádně dokončena a člověk si myslí, že se nic neděje. Výše zmíněná chybová hláška vyskakuje, pokud tlačítko pro spuštění makra stisknete více než jednou.

    S pozdravem

    Aňa Tomášková.

  3. Marek | 28. března 2018

    Děkuji.