Na to stačí maticový vzorec (Ctrl+Shift+Enter). Do
B6 na liste
Error_graph_2017 vložte toto a rozkopírujte po
M6.
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 SubEDIT:
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 Witha 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").Valueto 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), "<>") - 1alebo
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
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.
Kód: Vybrat vše
Dim arrPole(1 to 2, 1 to 12) As Longa 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
-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
...