No to je pekná pakáreň. Zisťovanie, čo Vám tam na čo je, aký to má účel, a čo ste asi chcel dosiahnuť, je docela HardCore.
Urobil som Vám každopádne 2 verzie makra na výpis podľa kritérií.
Jedno používa ten Váš pomocný list (ktorý ale nijako nereflektuje na prípadné zmeny v liste Data [???]). Druhé používa Rozšírený filter a nepotrebuje pomocný list, a teda ani aktualizáciu údajov, lebo ich berie rovno z listu Data.
Kód: Vybrat vše
Sub Vyfiltruj_tabulku_a_zobraz() 'Filtruje podľa kritérií s pomocou pomocného listu
Dim rngFLT As Range, rngVysledok As Range, Riadkov As Long, V()
With wsFLTmakro
Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row - 12 'Počet starých riadkov v liste "Filtr + makro"
If Riadkov > 0 Then .Cells(13, 1).Resize(Riadkov, 15).ClearContents 'Ak sú nejaké staré riadky tak ich vymaž
With wsPomocny
Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row - 2 'Počet riadkov v liste "pomocny_list"
If Riadkov = 0 Then MsgBox "Chýbajú dáta v pomocnom liste.", vbExclamation: Exit Sub 'Ak žiadne niesú - oznam
Set rngFLT = .Cells(2, 1).Resize(Riadkov, 17) 'Nastav celú oblasť dát v liste "pomocny_list"
End With
Application.ScreenUpdating = False 'Vypni prekresľovanie obrazovky
rngFLT.AutoFilter Field:=17, Criteria1:="ano" 'Aplikuj filter
On Error Resume Next 'Preber vyhodnocovanie chyby od Excelu
Set rngVysledok = rngFLT.Offset(1, 0).Resize(, 15).SpecialCells(xlCellTypeVisible) 'Nastav oblasť na vyfiltrované riadky
On Error GoTo 0 'Vráť vyhodnocovanie chyby Excelu
If Not rngVysledok Is Nothing Then 'Ak nejaké vyfiltrované riadky sú
V = rngVysledok.Value2 'Odlož si dáta z týchto riadkov do poľa
.Cells(13, 1).Resize(UBound(V, 1), 15).Value2 = V 'Zapíš dáta do listu "Filtr + makro"
Set rngVysledok = Nothing 'Uvoľni výslednú oblasť z pamäte
Erase V 'Vymaž pole z pamäte
Else
MsgBox "Kritériám nevyhovyje žiaden záznam.", vbInformation 'Ak nie sú žiadne vyfiltrované riadky - oznam
End If
rngFLT.AutoFilter Field:=17 'Vrátiť filter naspäť
Set rngFLT = Nothing 'Uvoľni oblasť filtra z pamäte
Application.ScreenUpdating = True 'Zapni prekresľovanie obrazovky
End With
End Sub
Kód: Vybrat vše
Sub Vyfiltruj_tabulku_a_zobraz_2() 'Filtruje podľa kritérií s pomocou Rozšíreného filtru
Dim Riadkov As Long
With wsFLTmakro
Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row - 12 'Počet starých riadkov v liste "Filtr + makro"
If Riadkov > 0 Then .Cells(13, 1).Resize(Riadkov, 15).ClearContents 'Ak sú nejaké staré riadky tak ich vymaž
With wsData
Riadkov = .Cells(Rows.Count, 1).End(xlUp).Row - 2 'Počet riadkov v liste "Data"
If Riadkov = 0 Then MsgBox "Chýbajú dáta.", vbExclamation: Exit Sub 'Ak žiadne niesú - oznam
.Cells(2, 1).Resize(Riadkov, 15).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wsKriteria.Range("L13:M14"), CopyToRange:=wsFLTmakro.Range("A12:O12"), Unique:=False 'Vyfiltruj kópiu dát podľa kritérií do listu "Filtr + makro"
End With
If .Cells(Rows.Count, 1).End(xlUp).Row - 12 = 0 Then MsgBox "Kritériám nevyhovyje žiaden záznam.", vbInformation 'Ak nie sú žiadne vyfiltrované riadky - oznam
End With
End Sub
Zjednodušil som mazacie makro pre Statistiky na jediný riadok.
Zjednodušil som makro na vkladanie vzorcov, je bez Select-ov.
Vzorce :
-Nie sú vôbec dynamické, teda pri zmene údajov nebudú počítať správne (napr. roky). Ale možno je to iba na ukážku funkcií [???], lebo napr. SUM/SUMA by sa v F5:G8 pri dynamických dátach nedal použiť, musel by sa použiť SUMIF. Rovnako by musel ísť AVERAGEIF namiesto AVERAGE/PRŮMĚR v D27:K27.
-V D36:E36 má byť určite COUNTIF ? Je z ostatnými nekonzistentný, nepočíta jadrá ale "Samsung". To tam máte vzorec z Q6.
- S13:V20 (S66:V73) - keď SUMIF, tak s rovnako vysokými parametrami, alebo použiť SUMIFS na celý stĺpec. Parametre zadajte nie natvrdo text, ale bunku. Ten SUMIFS by bol potom v S13
Kód: Vybrat vše
=SUMIFS(Data!$O$3:$O$102;Data!$A$3:$A$102;$R13;Data!$H$3:$H$102;S$12)
a rozkopírovať ho do S13:V20.
- V S31:V33 je zbytočné počítať po riadok 153, keď nič nieje dynamické, a teda nemôžete mať viac riadkov ako máte (102), lebo je riziko, že sa pridá napr. riadok s modelom od Xiaomi, a je to v háji lebo sa nikde s tým neráta. Detto v D16:K19.
-Vymenil som vzorec v Kriteria!L14:M14 za INDEX (Vami použitý CHOOSE/ZVOLIT nieje vhodný).
-CZ názvy vzorcov, čo máte na ukážku odložené B58:C70, by ste mal radšej urobiť tak, že najskôr cez VBA vložíte tie vzorce do bunky, a potom z tej bunky prečítate hodnotu FormulaLocal, ktorá Vám vráti vzorec preložený do konkrétneho jazyka, v akom práve spustený Excel je. Ako príklad som Vám urobil C59:C62.
Premenoval som kódové názvy listov, aby sa na ne dalo ľahšie a rýchlejšie odkazovať.
Ale tých poznámok by bolo k tomu oveľa oveľa viac, no to by som za Vás spravil celú semestrálku ...
Ostatné veci sa mi lúštiť už nechcelo.
Dodatečně přidáno po 40 minutách 43 vteřinách:EDIT:
K
druhému vláknu :
Ako ste vypočítal ten priemer 10 532 Kč pre iPhone v roku 2015 ? Mne to vychádza 19 612,84 Kč. A to Vaše číslo mi nevychádza pri žiadnej značke v žiadnom roku.