Tak skúste...
Skúste či bude vyhovovať "WeekNum" (bez toho "Iso"). Len si treba nájsť správny druhý parameter (typ výsledku) - teda ako má počítať týždeň.
=(D2<>"X")+(E2<>"XX")+(F2<>"XXX")
Tak nahraďte
Format(Date, "yyyy.mm.dd")
týmto
Application.IsoWeekNum(Date)
Vyplnte tú tabuľku denného plánu aspoň z časti tak, ako má byť vyplnená. Manuálne. A my Vám spravíme na to vzorce. Nepochopil som totiž, napr. ako majú byť údaje rozložené?
Do riadku za sebou ??? - načo potom sú tam ďalšie riadky v niektorých kategóriách ?
Do stĺpca pod seba ??? - a načo sú tam potom ďalšie stĺpce ?
Doobedná 1 riadok, poobedná druhý ? - a čo ostatné polia?
...
Kto preboha vymyslel zadávanie čísel v smenách ako "1" a "2" na miesto 1 a 2 ?
manipulanti, seřizovači a skladníci - Dlhý a krátky týždeň je v prípade výpisu zamestnancov v danom dni irelevantný udaj. Na tom nezáleží. Ide len o to, vypísať každého v danom dni, kto má nejaké číslo (nieje prázdne) ? V tom prípade, prečo je tam 1 a 2 ? To je doobedná a poobedná ? To je zvláštne, lebo ani v jeden deň sa nerobí aj doobeda aj poobede ? Tým smenám fakt nerozumiem.
Nejaký ten príklad.
To by malo ísť aj normálnym vzorcom bez matice:
=SUMPRODUCT(SUBTOTAL(3;OFFSET(B2;ROW(B2:B99999)-2;0));--(B2:B99999="ANO"))
=SOUČIN.SKALÁRNÍ(SUBTOTAL(3;POSUN(B2;ŘÁDEK(B2:B99999)-2;0));--(B2:B99999="ANO"))
SUMPRODUCT/SOUČIN.SKALÁRNÍ robí maticový výpočet, ale nehrozí pri ňom častá chyba s nesprávnym zadaním maticového vzorca, či jeho neúmyselným zrušením.
Dá sa to vzorcom rovno aj zoradiť A->Z:
=IFERROR(INDEX(List;MATCH(0;IF(MAX(NOT(COUNTIF($B$1:B1;List))*(COUNTIF(List;">"&List)+1))=(COUNTIF(List;">"&List)+1);0;1);0));"")
=IFERROR(INDEX(List;POZVYHLEDAT(0;KDYŽ(MAX(NE(COUNTIF($B$1:B1;List))*(COUNTIF(List;">"&List)+1))=(COUNTIF(List;">"&List)+1);0;1);0));"")
Príloha žiadna. Ani riadiaci súbor, ani dátový súbor, ani štruktúra zložky, ani podrobnosti o umiestnení ostatných dát v zošitoch, ani počte listov. Dokonca ani to uvedené makro nieje celé.
Makro nijako neskúšam, lebo vytvárať si preň prostredie nebudem. Tak len na pohľad:
"v určené složce i podsložkách (zkrátka sběr dat)" - Nevidím síce celé makro, ale o tom pochybujem. To musí byť rekurzívna metóda, aby prešla všetky zložky a ich podzložky atď, a tu navyše nekontroluje ani hlavnú zložku.
LR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A3:P3" & LR).EntireRow.Copy
To je zle! Veď do LR sa uloží posledný vyplnený riadok v A:A dolovaného listu. Tak napr. 10. Ale kopírovaná oblasť bude A3:P310 - vďaka tej napísanej 3-ojke. O možnom nevyplnenom údaji v stĺpci A:A hovoríte v suvislosti s týmto dolovaným listom, alebo s nasledujúcim riadkom ? :
wbMain.Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
Lebo tento riadok na prvý pohľad robí tú Vašu "chybu". Nemôžete skúmať ...End(xlUp)... pri každom prechode v stĺpci A:A, lebo môže byť nevyplnený. Namiesto toho si nadefinujte premennú
Dim RiadokZapisu As Long
ale kde a ako ju použiť záleží na celej koncepcii makra, ktoré nevidíme. Napr. môže byť potreba globálna premenná v prípade miltiprocedurálneho makra, alebo lokálna ak je to len 1 procedúra. V nej napr. predpokladajme, že má združená tabuľka hlavičku.
Ďalej čítajte počet riadkov podľa použitej oblasti (neberie ohľad iba na stĺpec A:A, ale tiež záleží na usporiadaní dolovaných dát, ktoré nevidíme)
UsedRange.Rows.Count + 1
a teda namiesto
wbMain.Sheets(ws.Name).Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
dajte napr. (odbrucha bez skúšania !)
RiadokZapisu = wbMain.Sheets(ws.Name).UsedRange.Rows.Count + 1
wbMain.Sheets(ws.Name).Range("A" & RiadokZapisu).PasteSpecial xlPasteValues
Každopádne ak sa jedná o zber dát, tak rozhodne nieje na mieste robiť Copy Paste s formátmi buniek a pod, ale stačí iba hodnoty čítať - to bude rýchlejšie. Ďalej by som to asi robil poľom a zapisoval naraz, nie po jednom - opäť urýchlenie.
Každopádne na takéto všelijaké dolovanie dát je vhodný PowerQuery, ktorý by Vám tu možno aj niektorí borci pomohli urobiť, ale bez príkladových súborov určo nie ...
...
S tým sa dá ihruškať ...
Skúste ešte úplne vynechať Copy.
Sub vlozeniNOVEHOkomentare()
'
' Makro1 Makro
'
Dim R As Long
Application.ScreenUpdating = False
R = ActiveCell.Row + 1
With Sheets("Zápis KDS")
.Cells(R, 1).Insert
With .Cells(R, 1).Resize(, 9)
.Value = Sheets("KD (pomoc)").Range("A5:I5").Value
.Cells(1, 5).Select
.Resize(, 7).Borders.Weight = xlHairline
.Cells(1, 1).NumberFormat = "@""-"""
.Cells(1, 2).NumberFormat = "0"
.Cells(1, 4).NumberFormat = "d/m/yy;@"
.Cells(1, 7).NumberFormat = "dd/mm/yy"
Union(.Cells(1, 3), .Cells(1, 5).Resize(, 2), .Cells(1, 8).Resize(, 2)).NumberFormat = "General"
End With
End With
Application.ScreenUpdating = True
'Calculate
End Sub
Skúste vymeniť to makro za iné.
Sub vlozeniNOVEHOkomentare()
'
' Makro1 Makro
'
Dim R As Long
Application.ScreenUpdating = False
Sheets("KD (pomoc)").Rows(5).Copy
R = ActiveCell.Row + 1
With Sheets("Zápis KDS")
.Cells(R, 1).Insert Shift:=xlDown
With .Cells(R, 1).Resize(, 9)
.Value = .Value
.Cells(1, 5).Select
End With
End With
Application.ScreenUpdating = True
Calculate
End Sub
A myslím, že volanie metódy Calculate tam nieje potrebné.
Po doplnení sviatkov do Vašeho súboru to normálne funguje ...
Alindros dostal navrhnuté riešenie v duplicitnej téme.
Inak tú istú tému ste založil 2.6.2019 a potom túto 10.6.2019. To sa nerobí !
Tak skúste objekt Tabuľka a Rýchly filter založený na vzorci s COUNTIFS v pomocnom stĺpci.
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.