Příspěvky uživatele
< návrat zpět
A čo sa stane ak bude kód umiestnený v samostatnej procedúre, ktorú z Worksheet_Change zavoláte ?
Prípadne kód rozdeľte na samostatné čiastkové alebo parametrizované procedúry. Obmedzenie je 64 KB.
Nie nefunguje!
1. opravte si oddelenie mien:
Anetta. Aneta
Maxmilian, Maxmilián,Maximilian
Amálie. Libuše
Oliver Olivia, Olívie
Michaela ,Michala
2. Vzorec sa musí upraviť tak, aby hľadal presné meno, nie iba jeho časť. Teda pridať oddeľovač mien ", " na začiatok aj koniec:
=MIN(IF(IFERROR(SEARCH(", "&B1&", ";", "&B3:B368&", ");0)>0;C3:C368))
=MIN(KDYŽ(IFERROR(HLEDAT(", "&B1&", ";", "&B3:B368&", ");0)>0;C3:C368))
Inak Vám totiž na tieto nájde zlý dátum, lebo sú časťou iného mena:
Gabriel Dita Ema Ota Alex Ivo
Emil Kamila Jarmil Antonin Jan Ivan
Ladislav Petr Nora Libor Viktor Lada
Alena Bohuslav Marcel Nina Erik Bohdan
Evžen Martin Tibor Ondřej Iva Julia
Dana Daniel Dan Miloslav Šimon Simon
Simeon Štěpán
3. Tieto mená sú tam 2x (v rôznych dátumoch):
Kamila
Petr
Miloslav
4. Ak by ste chcel eliminovať dátum 0 (0.1.1900), ktorý dostanete pri neexistujúcom mene, tak treba zmeniť vzorec na takýto:
=IFERROR(INDEX(C3:C368;MATCH(TRUE;SEARCH(", "&B1&", ";", "&B3:B368&", ")>0;0));"")
=IFERROR(INDEX(C3:C368;POZVYHLEDAT(PRAVDA;HLEDAT(", "&B1&", ";", "&B3:B368&", ")>0;0));"")
alebo tento nematicový:
=IFERROR(LOOKUP(TRUE;SEARCH(", "&B1&", ";", "&B3:B368&", ")>0;C3:C368);"")
=IFERROR(VYHLEDAT(PRAVDA;HLEDAT(", "&B1&", ";", "&B3:B368&", ")>0;C3:C368);"")
PS: V Office 2010 CZ je potrebné funkciu IFERROR premenovať na CHYBHODN. Vo vyšších verziách Office CZ sa už podľa všetkého dá použiť aj názov IFERROR. Ak máte ešte starší Office 2003, treba IFERROR funkciu nahradiť konštrukciou
IF(ISERROR(X);0;X)
KDYŽ(JE.CHYBHODN(X);0;X)
maticový?
=INDEX(C3:C368;MIN(IF(IFERROR(SEARCH(B1;B3:B368);0)>0;ROW(B3:B368)-2)))
=INDEX(C3:C368;MIN(KDYŽ(IFERROR(HLEDAT(B1;B3:B368);0)>0;ŘÁDEK(B3:B368)-2)))
alebo iba
=MIN(IF(IFERROR(SEARCH(B1;B3:B368);0)>0;C3:C368))
=MIN(KDYŽ(IFERROR(HLEDAT(B1;B3:B368);0)>0;C3:C368))
Našiel som ešte jeden zaujímavý vzorček bez tabuľky, len je potrebné si skontrolovať tie dátumy v poli:
=LOOKUP(--TEXT(D1;"mdd");{101\121\220\321\421\521\621\724\824\924\1024\1123\1222;"Kozoroh"\"Vodnář"\"Ryby"\"Beran"\"Býk"\"Blíženci"\"Rak"\"Lev"\"Panna"\"Váhy"\"Štír"\"Střelec"\"Kozoroh"})
=VYHLEDAT(--HODNOTA.NA.TEXT(D1;"mdd");{101\121\220\321\421\521\621\724\824\924\1024\1123\1222;"Kozoroh"\"Vodnář"\"Ryby"\"Beran"\"Býk"\"Blíženci"\"Rak"\"Lev"\"Panna"\"Váhy"\"Štír"\"Střelec"\"Kozoroh"})
=IFERROR(INDEX($F$3:$F$7;MATCH(1;($D$1>=$B$3:$B$7)*($D$1<=$D$3:$D$7);0));"Chyba")
=IFERROR(INDEX($F$3:$F$7;POZVYHLEDAT(1;($D$1>=$B$3:$B$7)*($D$1<=$D$3:$D$7);0));"Chyba")
alebo nematicový
=IFERROR(INDEX($F$3:$F$7;SUMPRODUCT(($D$1>=$B$3:$B$7)*($D$1<=$D$3:$D$7)*(ROW($F$3:$F$7)-2)));"Chyba")
=IFERROR(INDEX($F$3:$F$7;SOUČIN.SKALÁRNÍ(($D$1>=$B$3:$B$7)*($D$1<=$D$3:$D$7)*(ŘÁDEK($F$3:$F$7)-2)));"Chyba")
či
=IFERROR(INDEX($F$3:$F$7;SUMPRODUCT(($D$1>=$B$3:$B$7)*($D$1<=$D$3:$D$7)*{1;2;3;4;5}));"Chyba")
=IFERROR(INDEX($F$3:$F$7;SOUČIN.SKALÁRNÍ(($D$1>=$B$3:$B$7)*($D$1<=$D$3:$D$7)*{1;2;3;4;5}));"Chyba")
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet, Name As String, iName As Integer, vShow, iShow As Integer
If Not Intersect(Range("A1"), Target) Is Nothing Then
vShow = Range("A1").Value
If Not IsEmpty(vShow) And IsNumeric(vShow) Then
iShow = Val(vShow)
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
With ws
Name = Replace(.Name, "List", "")
If Name <> "Master" And IsNumeric(Name) Then
iName = Val(Name)
If iName <= iShow Then .Visible = xlSheetVisible Else .Visible = xlSheetHidden
End If
End With
Next ws
Application.ScreenUpdating = True
End If
End If
End Sub
Máte tam priloženú chybnú prílohu. Nahrajte ju znova.
Prílohu XLSM môžete pridať iba zabalenú do ZIP. Tu máte návrh riešenia, bez kontroly či obsahuje list nejaké dáta, či existuje list a pod.:
Sub Copy2Sheet()
Dim LastRow As Long, List As String
With Sheets("TABKOL")
LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
List = .Range("AB2").Value
Sheets(List).Range("A1:Y" & LastRow).Value = .Range("B1:Z" & LastRow).Value
Application.Goto Sheets(List).Range("A1")
End With
End Sub
A nebude stačiť použiť písmo WingDings na Label ?
Mne to fachá. Tak veľa zdaru.
Ten 1 pomocný stĺp bych tam nechal pre PF
=XOR(D3<>D2;U2)
EDIT: Sorry marjankaj, nevšimol som si. Keď som reloadoval, tak to tu nebolo.
Chýbajú tam apostrofy
CESTA = "'[" & ThisWorkbook.Name & "]" & "List1'!D5"
ale hlavne to postráda zmysel, načítať hodnotu otvoreného súboru cez EVALUATE. Veď poznáte meno zošitu aj listu aj adresu bunky, tak si dajte
Workbooks("TEST5.xlsm").Worksheets("List1").Range("D5").Value
a
ThisWorkbook.Worksheets("List1").Range("D5").Value
OT: @ marjankaj : 
Ale prd, len som lenivý, nechce sa mi, som taký nejaký poklesnutý a demotivovaný z tej celej situácie okolo covitu ... nikoho neumravňujem 
Dajte nejakú prílohu, nech si to nemusíme vytvárať zase sami. Aspoň pár kategórií a dát. Dáta nemusia byť tie Vaše, kľudne vymyslené, ale rovnakého formátu, typu a rozmiestnenia.
Návod ako to sprevádzkovať.
Uživatelské menu
\nMenu
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Helios iNuvio
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.
RSS nejnovější články