Příspěvky uživatele

Ja čo si pamätám, tak u mňa "zlobí" schránka vo VBA a celkovo aj v Exceli už od 2013. A skúšal som všetky Exceli 2013/2016/2019 v kombináciách s Win8.1 a W10 (všetky polročné verzie od 9/2015) s aktualizáciami aj bez. Jedine čo som tuším neskúšal je Office 365. Napr. návody na API Clipboard Management vo VBA čo sú na nete nefungujú (nerozbehal som), Excel vo VBA padal pri kopírovaní celého listu do iného súboru. Ale aj bez VBA mám problém min od 2016, pri kopírovaní bunky Ctrl+C a prilepení inde Ctrl+V nepravideľne vypisuje chybu "Vyskytol sa problém so schránkou ..." a Excel stratí kurzor. A pod... Nie som jediný čo má problém so schránkou. Ale zvykol som si častejšie sejvovať, a nemám chuť zisťovať "jádro pudla".

Osobne vysvetliť neviem.

Skúste 32-bit verziu inštalácie.

To je jednoduché. Sú použité 3 funkcie SumIf, VLookup, CountIf. Ak sa pozriete na potrebnú skladbu parametrov týchto funkcií, tak zistíte prečo to tak je. Nastavím si podľa počtu údajov prvý stĺpec. Ten bude ako parameter v CountIf. Vlookup potrebuje ale ucelenú viacstĺpcovú tabuľku, teda preto Resize. No a SumIf potrebuje dve samostatné oblasti preto Offset.

No, tak s tou rýchlosťou by sa dalo podstatne pohnúť, ak by nebolo vkladanie vzorcov k duplicitným hodnotám, ale výpočet do kolekcie a iba raz. Potom by sa z kolekcie ťahali len hotové výpočty.
Sub VlozVzorce3()
Dim DR As Long, VR As Long, D(), V(), VV(), i As Long, Col As New Collection, Item, RNG1 As Range, RNG2 As Range, RNG3 As Range

With List2
DR = .Cells(Rows.Count, 1).End(xlUp).Row - 1
D = .Cells(2, 1).Resize(DR, 2).Value
Set RNG1 = .Cells(2, 1).Resize(DR)
Set RNG2 = RNG1.Offset(0, 1)
Set RNG3 = RNG1.Resize(, 2)
End With

With List1
VR = .Cells(Rows.Count, 2).End(xlUp).Row - 4
V = .Cells(5, 2).Resize(VR).Value
End With

On Error Resume Next
With WorksheetFunction
For i = 1 To DR
Item = Col(CStr(D(i, 1)))
If Err.Number <> 0 Then
Col.Add Array(.SumIf(RNG1, D(i, 1), RNG2), .VLookup(D(i, 1), RNG3, 2, 0), .CountIf(RNG1, D(i, 1))), CStr(D(i, 1))
Err.Clear
End If
Next i
End With

ReDim VV(1 To VR, 1 To 5)
For i = 1 To VR
Item = Col(V(i, 1))
If Err.Number = 0 Then
VV(i, 1) = Item(0)
VV(i, 3) = Item(1)
VV(i, 5) = Item(2)
Else
Err.Clear
End If
Next i

List1.Cells(5, 3).Resize(VR, 5).Value = VV
End Sub

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));"")

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje