Zdravím,
Mohli by jste mi poradit mám celkem obsáhlé makro, kde bych potřeboval vypisovat všechny buňky které jsou přidané ve stejný měsíc, jedná se pouze o sloupec "N" , kde je napsané datum kdy byla chyba přidána.
Takže bych potřeboval aby mě makro projelo celý seznam ve sloupci "N" a vypsalo mi na další list do určité buňky "X" kolik jich v každém měsíci bylo nalezeno.
Zajímá mě pouze měsíc ne den ani rok.
V příloze přikládám obrázky, aby jste měli lepší info:)
Mohl by mi s tím někdo pomoct?
https://ufile.io/zheu0
https://imgur.com/gtJnGPP
https://imgur.com/2eNOI7H
Díky moc:)
Martin
Excel VBA Vyhledávání podle datumu
-
- Level 4.5
- Příspěvky: 1544
- Registrován: březen 11
- Bydliště: Drsná Vysočina :D
- Pohlaví:
- Stav:
Offline
Re: Excel VBA Vyhledávání podle datumu
Zdravím,
třeba takto?
třeba takto?
Kód: Vybrat vše
Sub WriteCountErr()
Dim lastrow As Integer, i As Integer
Dim MyDate, MyMonth
With Sheets("OPEN")
'posledni radek v sl.N
lastrow = .Cells(.Cells.Rows.Count, "N").End(xlUp).Row
'opakuj pro vsechny radky krom zahlaví
For i = lastrow To 2 Step -1
MyDate = .Cells(i, "N")
MyMonth = Month(MyDate)
'zapis kazdy mesic na radek
Sheets("X").Cells(MyMonth, 1) = Sheets("X").Cells(MyMonth, 1) + 1
Next i
End With
End Sub
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Excel VBA Vyhledávání podle datumu
Na to stačí maticový vzorec (Ctrl+Shift+Enter). Do B6 na liste Error_graph_2017 vložte toto a rozkopírujte po M6.
Ale keď to chcete makrom, tak nie po jednej bunke, ale naraz cez pole:
EDIT:
Keď teraz pozerám na to Vaše makro, pochybujem o jeho korektnej funkčnosti. Sú tam technické a logické nedostatky.
Napr.:
-Pri získavaní názvu aktuálneho a predošlého mesiaca v časti Case "12" máte Mesic = "DEC" a Mesic2 = "JAN". Správne má byť ale Mesic2 = "NOV". Každopádne sa to dá oveľa kratšie zapísať, napr.:
-Nepoužívať neustále .Activate a .Select. Namiesto toho použite napr.:
a list nemusí byť vôbec aktívny.
-Odkladáte riadky 3,4,5,6,7,9,10. A riadok 8 nie ? Skráťte to na 1 riadok kódu namiesto 7 riadkov, napr.:
to isté pri
(tým riadkom 5 a 8 to asi vadiť nebude).
-Vyfarbujete oblasť "N12:Q21", ale v skutočnosti ju máte "N13:Q22".
-Nepoužívajte cyklus While a neustály .Select buniek na zistenie počtu. Použite napr. :
alebo
-Pri počítaní poc_chyb_pred_rokem_2016_objevleden/poc_chyb_od_roku_2016_objevleden ... nepočítate s rokom 2017 ? Ak sa má zarátať rok 2017 k tým ktoré sú po roku 2016 (čo je logické), nemôže byť operátor
ale musí byť
prípadne
-Ako odlišujete "Červ" ako "Červenec" od "Červ" ako "Červen" ?
-Nepoužívajte 24 premenných na mesiace pred a po r. 2016. Použite pole napr.
a nezapisujte po jednom (navyše ako som spomínal posunul ste všetky riadky, a zapisujete ich makrom na zlý riadok. Nemôžete len tak meniť rozloženie, keď máte viazané makro !):
ale zapíšte ich naraz
-Na počet riadkov/buniek nepoužívajte Integer, ale Long. Pozrite sa koľko má Excel od v. 2007 riadkov. Integer nestačí.
-Jednoduchšie by bolo nepoužívať "Leden 2016" ale použiť v bunkách normálny dátum 1.1.2016 a naformátovať ho vlastným formátom "mmmm yyyy" (v CZ je to "mmmm rrrr"), akurát že bude 1. písmenko malé. Potom ale zisťovanie mesiaca robíte jednoducho Month(bla bla), a nie škriabaním sa ľavou nohou za pravým uchom cez Left(Cells(radek, 5), 4) = "Červ"
...
Ďalej sa mi to už študovať ani nechce
...
Kód: Vybrat vše
=SUM((OPEN!$N$2:$N$1000<>"")*(MONTH(OPEN!$N$2:$N$1000)=COLUMN(A$1)))
=SUMA((OPEN!$N$2:$N$1000<>"")*(MĚSÍC(OPEN!$N$2:$N$1000)=SLOUPEC(A$1)))
Ale keď to chcete makrom, tak nie po jednej bunke, ale naraz cez pole:
Kód: Vybrat vše
Sub WriteCountErr()
Dim RowsCount As Long, i As Long, arrDate(), arrErrors(1 To 1, 1 To 12) As Long, MyMonth As Byte
With Sheets("OPEN")
RowsCount = .Cells(Rows.Count, 14).End(xlUp).Row - 1 'Počet řádků s daty v sl. N
If RowsCount > 0 Then 'Pokračuj když nejaké data jsou
ReDim arrDate(1 To RowsCount, 1 To 1)
If RowsCount = 1 Then 'Načíst data do pole
arrDate(1, 1) = .Cells(2, 14).Value2
Else
arrDate = .Cells(2, 14).Resize(RowsCount).Value2
End If
For i = 1 To RowsCount 'Opakuj pro všechny data
If Not IsEmpty(arrDate(i, 1)) Then 'Když to není prázdná bunka
MyMonth = Month(arrDate(i, 1)) 'Zjisti měsíc
arrErrors(1, MyMonth) = arrErrors(1, MyMonth) + 1 'Pričti počet chyb do pole počtú chyb, podle indexu měsíce
End If
Next i
End If
End With
Sheets("Error_graph_2017").Cells(6, 2).Resize(, 12) = arrErrors 'Zapiš počet chyb ve všech měsících najednou
End Sub
EDIT:
Keď teraz pozerám na to Vaše makro, pochybujem o jeho korektnej funkčnosti. Sú tam technické a logické nedostatky.
Napr.:
-Pri získavaní názvu aktuálneho a predošlého mesiaca v časti Case "12" máte Mesic = "DEC" a Mesic2 = "JAN". Správne má byť ale Mesic2 = "NOV". Každopádne sa to dá oveľa kratšie zapísať, napr.:
Kód: Vybrat vše
Dim arrMonths()
arrMonths = Array("DEC", "JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
Mesic = arrMonths(Month(Date))
Mesic2 = arrMonths(Month(Date) - 1)
-Nepoužívať neustále .Activate a .Select. Namiesto toho použite napr.:
Kód: Vybrat vše
With Worksheets("Error_graph_2017")
.Range("X3").Value = .Range("W3").Value
...
End With
a list nemusí byť vôbec aktívny.
-Odkladáte riadky 3,4,5,6,7,9,10. A riadok 8 nie ? Skráťte to na 1 riadok kódu namiesto 7 riadkov, napr.:
Kód: Vybrat vše
.Range("X3:X10").Value = .Range("W3:W10").Value
to isté pri
Kód: Vybrat vše
.Range("Y4:Y10").Value = .Range("W4:W10").Value
(tým riadkom 5 a 8 to asi vadiť nebude).
-Vyfarbujete oblasť "N12:Q21", ale v skutočnosti ju máte "N13:Q22".
-Nepoužívajte cyklus While a neustály .Select buniek na zistenie počtu. Použite napr. :
Kód: Vybrat vše
Pocet_chyb = WorksheetFunction.CountIf(Worksheets("OPEN").Columns(1), "<>") - 1
alebo
Kód: Vybrat vše
Pocet_chyb = Worksheets("OPEN").Cells(Rows.Count, 1).End(xlUp).Row - 1
-Pri počítaní poc_chyb_pred_rokem_2016_objevleden/poc_chyb_od_roku_2016_objevleden ... nepočítate s rokom 2017 ? Ak sa má zarátať rok 2017 k tým ktoré sú po roku 2016 (čo je logické), nemôže byť operátor
Kód: Vybrat vše
Right(Cells(radek, 4), 4) > 2017
ale musí byť
Kód: Vybrat vše
Right(Cells(radek, 4), 4) >= 2017
prípadne
Kód: Vybrat vše
Right(Cells(radek, 4), 4) > 2016
-Ako odlišujete "Červ" ako "Červenec" od "Červ" ako "Červen" ?
-Nepoužívajte 24 premenných na mesiace pred a po r. 2016. Použite pole napr.
Kód: Vybrat vše
Dim arrPole(1 to 2, 1 to 12) As Long
a nezapisujte po jednom (navyše ako som spomínal posunul ste všetky riadky, a zapisujete ich makrom na zlý riadok. Nemôžete len tak meniť rozloženie, keď máte viazané makro !):
Kód: Vybrat vše
Range("B7").Value = poc_chyb_pred_rokem_2016_objevleden
Range("B8").Value = poc_chyb_od_roku_2016_objevleden
...
ale zapíšte ich naraz
Kód: Vybrat vše
.Range("B8:M9").Value = arrPole
-Na počet riadkov/buniek nepoužívajte Integer, ale Long. Pozrite sa koľko má Excel od v. 2007 riadkov. Integer nestačí.
-Jednoduchšie by bolo nepoužívať "Leden 2016" ale použiť v bunkách normálny dátum 1.1.2016 a naformátovať ho vlastným formátom "mmmm yyyy" (v CZ je to "mmmm rrrr"), akurát že bude 1. písmenko malé. Potom ale zisťovanie mesiaca robíte jednoducho Month(bla bla), a nie škriabaním sa ľavou nohou za pravým uchom cez Left(Cells(radek, 5), 4) = "Červ"
...
Ďalej sa mi to už študovať ani nechce
...
- elninoslov
- Level 2.5
- Příspěvky: 366
- Registrován: červen 13
- Pohlaví:
- Stav:
Offline
Re: Excel VBA Vyhledávání podle datumu
Tak som sa pozrel na to bližšie. Zeleným je označené, čo som Vám zmenil a išlo by odstrániť. Len už nemám čas pozrieť na úplne posledný blok na to vyfarbenie tých pár buniek. Každopádne berte na vedomie, že som to napísal len tak z hlavy BEZ AKÉHOKOĽVEK SKÚŠANIA. Teda testujte si to na kópii súborov (to platí vlastne vždy) a prípadné chyby reportujte. Nechcelo sa mi to testovať, lebo mi to pripadá divné, bez bližšieho vysvetlenia. Skúste presne slovne v krokoch popísať čo sa má diať. Prípadne priložte aj ten druhý súbor, lebo to makro, čo tam máte je nešťastné...
Alebo si z toho zoberte len inšpirácie ...
Alebo si z toho zoberte len inšpirácie ...
- Přílohy
-
- eng_chyby---kopie úprava.xlsm
- (340.71 KiB) Staženo 35 x
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
-
Google vyhledávání-reCaptcha Příloha(y)
od ski1961 » 23 kvě 2023 16:58 » v Internet a internetové prohlížeče - 4
- 1904
-
od kecalek
Zobrazit poslední příspěvek
24 kvě 2023 14:59
-
-
-
Vyhledávání z adresní řádky - chyba (Chrome) Příloha(y)
od pikaso.andreas » 23 říj 2023 14:34 » v Internet a internetové prohlížeče - 1
- 2274
-
od rhsCZ
Zobrazit poslední příspěvek
25 říj 2023 19:55
-
-
- 16
- 5984
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 1
- 259
-
od Grimm
Zobrazit poslední příspěvek
12 bře 2024 21:43
-
- 2
- 1632
-
od honzzicek
Zobrazit poslední příspěvek
01 črc 2023 08:57
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 2 hosti