Excel - Makro "vyhledá a spočítá podle kritéria"

[Student1]

Dobrý den všem,
potřeboval bych poradit... co se týče maker v excelu tak jsem úplný začátečník... tak se ptám jestli by někdo nevěděl:

Potřeboval bych makro které by fungovalo na listu: Filtr + makro (4. list)
1) prohledá data v rozmezí A2:H102 na listu Data(1. list)
2)důležité sloupce A(Značka) - značka mobilu a H(Rok prodeje) od roku 2013 - 2016 a sloupec G(cena) - cena mobilu
3)makro podle buňěk na jiném listu -->Kritéria(3.list) bude vyhledávat řádky v listu Data a na listu Filtr + makro vypočítá průměrnou cenu vybraných mobilů podle kritérií v bunkách L13:M14 v listu Kritéria
buňky jsou v rozmezí : L13: M14 příklad --> Značka Rok prodeje
iPhone 2015

výpis listů v sešitu: Data, Statistiky, Kritéria, Filtr + makro, Kontigenční tabulka, a další....

.....výsledek co by to mělo dělat.....
na listu Kritéria se mění v buňkách L14 a M14 název telefonu a rok prodeje, podle těchto údajů makro vyhledá na listě Data z oblasti A2 : H102 a vypočítá průměr cen dané značky prodané v daném roce do jedné buňky, která bude na listě Filtr + makro

Děkuji moc za radu případně za napsané makro.

[Reklama]

[guest]

Potřebujete poradit nebo zveřejnit zakázku?

[Student1]

Je to spíše do školy na VŠ... je to semestrálka a je to poslední bod, který mi v projektu chybí :( prostě udělat to makro a neumím s tím hnout.

[elninoslov]

To bude potrebné priložiť nejakú prílohu, aspoň čiastočnú, nejakú ukážku obdobných dát ako Vaše (ak nechcete poskytnúť Vaše), rovnakého formátu a rozmiestnenia. Príklad toho čo máte, a príklad toho čo chcete (kľudne manuálne vytvorené s 5 riadkami)...

[Student1]

excel s makrem.xlsm

(111.86 KiB) Staženo 51 x

--> zde přikládám soubor, kde jsem to jen na ukázku vložil a snažil se to mírně vysvětlit a přiblížit :)

[elninoslov]

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.

[Student1]

zatím děkuji moc ! kouknu na to v pátek, zítra mě čekají 2 zápočtové testy. Když tak ještě napíšu, jste jednička (y) :)

[Student1]

Ještě bych měl malou prosbu :)
takto je to super, ale potřeboval bych tam ještě alespoň jedno makro s nějakým cyklem, třeba něco aby to počítalo z tabulky a vracelo do jedné buňky. Jelikož nevím pořádně jak využít ten cyklus tak nevím co na to vymyslet.
byl bych velice vděčný kdybyste mi s tím ještě pomohl, nějaký jednoduchý makro

excel-prace_ZD_2017.xlsm

(116.41 KiB) Staženo 35 x

[elninoslov]

No keď chcete/musíte použiť nejaký cyklus na predvádzanie niečoho, tak si vymyslite čo ja viem, napr. že chcete spočítať počet jedinečných hodnôt v oblasti (koľko je výrobcov a akých). Teda naprogramujme UDF s názvom JEDINECNE.

Kód: Vybrat vše

Function JEDINECNE(Oblast As Range, Optional Typ As Boolean = True) As Variant
Dim C As Collection, Riadkov As Long, Stlpcov As Long, arrObl(), x As Long, y As Long, sC

  Application.Volatile
 
  Set C = New Collection
  Riadkov = Oblast.Rows.Count
  Stlpcov = Oblast.Columns.Count
  ReDim arrObl(1 To Riadkov, 1 To Stlpcov)
  If Riadkov = 1 And Stlpcov = 1 Then arrObl(1, 1) = Oblast.Value2 Else arrObl = Oblast.Value2
 
  On Error Resume Next
  For y = 1 To Stlpcov
    For x = 1 To Riadkov
      If Not IsEmpty(arrObl(x, y)) Then C.Add arrObl(x, y), CStr(arrObl(x, y))
    Next x
  Next y
 
  Select Case Typ
    Case True: JEDINECNE = C.Count
    Case False: JEDINECNE = ""
                For Each sC In C
                  JEDINECNE = JEDINECNE & IIf(JEDINECNE = "", "", ",") & sC
                Next sC
  End Select
  Set C = Nothing: Erase arrObl
End Function

Má 2 parametre:
Oblast - Udáva oblasť ktorú cyklom prehľadávame, a z ktorej chceme získať počet alebo zoznam jedinečných záznamov. Môže byť viacriadková aj viacstĺpcová.
Typ - Nepovinný parameter nadobúda hodnoty:
1. - vynechá sa alebo je TRUE/PRAVDA - funkcia vráti počet jedinečných záznamov
2. - FALSE/NEPRAVDA - funkcia vráti zoznam jedinečných záznamov oddelený čiarkou

Na ukážku je použitá kolekcia (štruktúra Collection), pole (štruktúra Array) , 1 cyklus "For Each" a 2 cykly "For To".

Použitie SK:

Kód: Vybrat vše

=JEDINECNE(Data!A3:A102)
=JEDINECNE(Data!A3:A102;TRUE)
=JEDINECNE(Data!A3:A102;FALSE)

Použitie CZ:

Kód: Vybrat vše

=JEDINECNE(Data!A3:A102)
=JEDINECNE(Data!A3:A102;PRAVDA)
=JEDINECNE(Data!A3:A102;NEPRAVDA)

vrátia výsledky :

Kód: Vybrat vše

8
8
Honor,Huawai,iPhone,Lenovo,LG,Samsung,Sony,Nokia


Príklad v prílohe.

EDIT:
Až teraz som si všimol, že ste pridal prílohu "excel-prace_ZD_2017.xlsm", ktorá ale na prvý pohľad vyzerá rovnako ako tá odo mňa, tak sa mi ju nechce študovať čo ste v nej zmenil. Vidím tam tú poznámku o kontrole hlášky makra pri voľbe Sony/2013. To je v poriadku, veď Sony v roku 2013 žiadne zastúpenie nemá. Ak ide ešte o niečo iné v tej prílohe, tak to rovno napíšte, cele to kontrolovať nejdem.

Poznámka: Ešte ma napadá, že ja píšem premenné a poznámky v slovenčine, tak keď to chcete prezentovať ako svoje, tak si to prerobte do CZ. Hlavne pozor pri zmene všetkých premenných v makre. Nesprávna zmena, či nekompletná zmena = nefunkčnosť.