Makro na úpravu kontingenční tabulky

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

moogcz
nováček
Příspěvky: 7
Registrován: únor 12
Pohlaví: Muž
Stav:
Offline

Makro na úpravu kontingenční tabulky

Příspěvekod moogcz » 01 srp 2012 16:40

Zdravím všechny,

mám tentokrát prosbu ohledně makra. Vytvořil jsem si makro, které mi řadí v kontingenční tabulce řádky, podle předem daných pravidel (viz. příloha, v tomto vymyšleném případě ovoce :smile: ). Vše funguje tak jak má. Ale v případě, že jeden z druhů ovoce chybí, např. "Višně", které normálně řadí na pozici č.3, tak od tohoto místa již řazení nefunguje. Lze to nějak jednoduše prosím opravit?

Děkuji moc.

makro:

Sub Makro1()
'
' Makro1 Makro
'
' Klávesová zkratka: Ctrl+o
'
On Error Resume Next
Cells.Find(What:="Jahody", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Jahody").Position = 1
Cells.Find(What:="Rambutan", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Rambutan").Position = 2
Cells.Find(What:="Višně", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Višně").Position = 3
Cells.Find(What:="Švestky", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Švestky").Position = 4
Cells.Find(What:="Meruňky", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Meruňky").Position = 5
Cells.Find(What:="Ananas", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Ananas").Position = 6
Cells.Find(What:="Rybíz", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Rybíz").Position = 7
Cells.Find(What:="Pomelo", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Pomelo").Position = 8
Cells.Find(What:="Třešně", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Třešně").Position = 9
Cells.Find(What:="Kiwi", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveSheet.PivotTables("Kontingenční tabulka 1").PivotFields("Ovoce"). _
PivotItems("Kiwi").Position = 10
End Sub
Přílohy
Ovoce.xlsx
(13.42 KiB) Staženo 16 x

Reklama
cmuch
Level 4.5
Level 4.5
Příspěvky: 1547
Registrován: březen 11
Bydliště: Drsná Vysočina :D
Pohlaví: Muž
Stav:
Offline

Re: Makro na úpravu kontingenční tabulky

Příspěvekod cmuch » 01 srp 2012 18:26

Mě se to Tvé makro chová korektně.
Když něco nenajde tak to přeskočí a pokračuje normálně v řazení dál.
To co zbyde nechá na konci tak jak zůstalo.
Tak nevím. Zkoušeno v Ex2010.


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Prosím o úpravu kódu. Děkuji *
    od junis » 09 črc 2024 18:05 » v Kancelářské balíky
    4
    4416
    od junis Zobrazit poslední příspěvek
    22 črc 2024 17:54

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů