Skúste takto.
Asi to máte len na týchto vzorových súboroch, ale upozorním nato, že dátum vo vnútri súboru v C2 nieje rovnaký ako v názve súboru.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range, Bunka As Range, Area As Range, Hodnota
Set Zmena = Intersect(Cells(4, 2).Resize(, 14), Target)
If Not Zmena Is Nothing Then
Application.EnableEvents = False
For Each Area In Zmena.Areas
With Area
For Each Bunka In .Cells
Hodnota = Bunka.Value
If Len(Hodnota) > 0 Then Bunka.Formula = "=IFERROR(VLOOKUP(" & Hodnota & ",'" & ThisWorkbook.Path & "\hesla.xlsx'!HESLA,2,FALSE),""neplatné heslo"")"
Next Bunka
.Value = .Value
End With
Next Area
Application.EnableEvents = True
End If
End Sub
Nesmiete zabudnúť testovať či sgBanka = False. Vtedy bol totiž InputBox zrušený, bez zadania hodnoty. Makro treba zastaviť. To je úplne bežná vec, na ktorú treba myslieť.
Môj návrh rieši aj možnosť zadať 4.5 aj 4,5 a výsledok je vždy číslo 4,5. Vaše riešenie nefunguje, ak sa zadá bodka. Záleží asi aj na jazykovej mutácii. Pže niekde nieje desatinný oddeľovač čiarka, ako u nás. Nechce sa mi štartovať virtuálku s EN Win aj EN Office.
Sami musíte vedieť v akom prostredí u Vás čo môže nastať. Inak OK :)
EDIT:
Tak som to čiastočne overoval, a toto funguje za každých okolností Office SK, CZ, EN / Win SK, EN / W10, W7 / klávesnica SK, EN / oddeľovače "," "." / ošetrenie zrušenia InputBoxu.
Niekto dajte niečo jednoduchšie.
Sub pokus()
Dim ssgBanka As String
Dim sgPrescasy As Double
Dim sgBanka As Double
Dim Dec As String * 1, aDec As String * 1
Dec = Application.DecimalSeparator
aDec = IIf(Dec = ".", ",", ".")
sgPrescasy = 4.5
While ssgBanka <> "False" And Not IsNumeric(ssgBanka)
ssgBanka = Replace(Application.InputBox(Prompt:="Zadej pocet prescasových hodin", Default:=sgPrescasy, Type:=2), aDec, Dec)
Wend
If ssgBanka <> "False" Then sgBanka = CDbl(ssgBanka)
End Sub
Príklad. Ale už to nemôže byť ako Tabuľka, ale len tabuľka. Nefunguje totiž potom externý def. názov.
Môžete napr. použiť nejakú formu kontingenčnej tbl. Len nástrel, na to sú tu fachmani.
Skúste niečo takéto, len nástrel...
Sub pokus()
Dim ssgBanka As String
Dim sgPrescasy As Double
Dim sgBanka As Double
sgPrescasy = 4.5
While ssgBanka <> "False" And Not IsNumeric(ssgBanka)
ssgBanka = Replace(Application.InputBox(Prompt:="Zadej počet přesčasových hodin", Default:=sgPrescasy, Type:=2), ".", ",")
Wend
If ssgBanka <> "False" Then sgBanka = CDbl(ssgBanka)
End Sub
Ale dajte viac informácií:
...tieto 4 si budete môcť potom meniť, ale potrebujem ich vedieť aj teraz...
Na ktorom riadku začína kontrolovaná oblasť?
Na ktorom riadku končí?
Na ktorom stĺpci začína?
Na ktorom stĺpci končí?
"na konci každého riadka" - čo to znamená, že každý riadok končí na inom mieste? Ak áno, čo určuje kde je koniec? Ak to tak nieje, tak ktorý stĺpec je určený na zápis dátumu.
"vložím alebo zmením hocijaké číslo" - to znamená, že v oblasti sú aj nečísla, a keď sa zmenia tie, tak sa dátum nemení? Ak áno, tak treba uchovávať v skrytom liste kompletne minulý stav oblasti pre porovnanie čo bola pôvodná hodnota. S tým súvisí aj otázka čo robiť ak je zmenení číslo na nečíslo a opačne.
Dátum sa má zapísať aj keď sa vymažú údaje? Teda zmažem jednu bunku, má sa zapísať dátum? Alebo zmažem všetky bunky v riadku, má sa zapísať dátum?
Môže nastať viacoblastná zmena? Teda 1 bunka z riadku 4, druhá z riadku 7, tretia z riadku 20 ... ?
...
Dalo aj nedalo.
V Exceli je možné zapnúť Iteračný výpočet, potom sa dá vo vzorci odkazovať v bunke sa samu seba, čo sa dá využiť, pri kontrole s inou bunkou. Teda zmení čas iba ak je iná bunka rozdielna. Ale akonáhle to otvoríte na PC kde nieje Iteračný výpočet zapnutý je to v háji.
Potom by to možno šlo urobiť tak, že by bolo síce makro, ale ako doplnok do Excelu. Normálne hore v lište. A buď by to neustále kontrolovalo, či nieje otvorený daný zošit, alebo by sa musel daný zošit tlačítkom v lište "zaregistrovať" obslužnému makru v doplnku. Vtedy by tiež už samotný súbor nemusel byť XLSM.
Všetky 3 riešenia sú z nejakého dôvodu naprd.
No to rozhodne nieje. Dá sa v ňom robiť všeličo, ale presnejšej grafiky sa nedočkáte. Kruh nevytlačí ako kruh, nestále farby podľa verzie Office, nedá sa predvídať či text vojde do buky pri tlači alebo na stránku. Žiaľ ale na to nebol ani vôbec plánovaný
Niečo podobné ako makrom tu? Ak áno treba pridať prílohu, aby bolo jasné, ktorá presne oblasť sa má kontrolovať, a kam sa zapisuje čas.
To záleží od konkrétneho makra, čo robí, s akými vstupmi/výstupmi počíta. Každopádne je vhodné pri komplikovaných makrách odkazovať na konkrétne listy (kľudne aj premenné), nie na ActiveSheet, ľahko sa Vám môže stať, že si poškodíte data, ak budete napr. debugovať a prepnete list. Prípadne čo ak užívateľ spustí makro z iného listu...
Každopádne to ale nerieši Váš problém. Na to, aby Vám na to ktokoľvek pozrel, musíte to makro zverejniť. No ak má to makro rozsah >64 KB, tak to len tak nebude. Také veľké makro bude asi nahrané cez Macro Recorder, nie ? Ten tam ľúbi nasekať poriadne zbytočnosti, ale k tomu sa opäť môžeme vyjadriť až po zverejnení prílohy a popisu makra. Bez toho nič.
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"})
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.