• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

To slúži na uvoľnenie objektu z pamäti. Nieje to vždy nevyhnutné, ale je to dobrý programátorský zvyk.

Každopádne s tou rýchlosťou sa asi nebude dať mnoho urobiť, ale zase na druhej strane to na danom príklade nieje až také strašné. Podľa mňa v pohode. Skúsil som ešte inú metódu, ale bez rozdielu.

Sub VlozVzorce2()
Dim DR As Long, VR As Long
DR = List2.Cells(Rows.Count, 1).End(xlUp).Row
VR = List1.Cells(Rows.Count, 2).End(xlUp).Row - 4

Application.ScreenUpdating = False
With List1.Cells(5, 3).Resize(VR, 5)
.Formula = Array("=SUMIF(DATA!A$2:A$" & DR & ",VYPOČET!$B5,DATA!B$2:B$" & DR & ")", , "=VLOOKUP(B5,DATA!A$2:B$" & DR & ",2,0)", , "=COUNTIF(DATA!A$2:A$" & DR & ",VYPOČET!B5)")
.Value = .Value
End With
Application.ScreenUpdating = True
End Sub

Na to sa dá použiť aj naťahovací vzorec VLOOKUP/SVYHLEDAT:
=VLOOKUP(A2;$A$16:$I$23;MATCH($C$1;$C$15:$I$15;0)+2;FALSE)
=SVYHLEDAT(A2;$A$16:$I$23;POZVYHLEDAT($C$1;$C$15:$I$15;0)+2;NEPRAVDA)
alebo nenaťahovací (tak ako tam máte)
=INDEX($C$16:$I$23;1;MATCH($C$1;$C$15:$I$15;0))
=INDEX($C$16:$I$23;1;POZVYHLEDAT($C$1;$C$15:$I$15;0))
kde tú "1" zmeníte v každom riadku za 2, 3, 4 ... 8.
Ďalej sa dá použiť aj naťahovací/nenaťahovací OFFSET/POSUN:
=OFFSET($B$15;ROW(A1);MATCH($C$1;$C$15:$I$15;0))
=POSUN($B$15;ŘÁDEK(A1);POZVYHLEDAT($C$1;$C$15:$I$15;0))
(v nenaťahovacom sa vymení to ROW(A1) za čísla ako vyššie)
...

Tu pomôže asi iba ComboBox.

Vaše makro by sa dalo skrátiť napr. na:
Sub UpravSloupce()
With Range("C1, E1, G1, I1, K1, M1, O1, Q1, S1, U1, W1, Y1").EntireColumn
.Hidden = Not .Hidden
End With

With Range("B1, D1, F1, H1, J1, K1, N1, P1, R1, T1, V1, X1")
.ColumnWidth = IIf(.ColumnWidth = 20.71, 18.71, 20.71)
End With
End Sub
Vaše je zase pekne čitateľné, ale vadí mi na ňom to 2x zbytočné True v riadku
Range(SloupceH).EntireColumn.Hidden = True = Not Range(SloupceH).EntireColumn.Hidden = True
stačí iba negácia
Range(SloupceH).EntireColumn.Hidden = Not Range(SloupceH).EntireColumn.Hidden

Dá sa to aj bez zmeny vzorcom.

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

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse