Příspěvky uživatele

No príloha má 1KB, takže je nefunkčná. Skúste ešte raz.

EDIT: Inak stačí asi iba toto:
=FIND(TEXT(B3;"dd.mm");"01.01,06.01,"&TEXT(DOLLAR(("4/"&YEAR(B3))/7+MOD(19*MOD(YEAR(B3);19)-7;30)*14%;)*7-8;"dd.mm,")&TEXT(DOLLAR(("4/"&YEAR(B3))/7+MOD(19*MOD(YEAR(B3);19)-7;30)*14%;)*7-5;"dd.mm,")&"01.05,08.05,05.07,29.08,01.09,15.09,01.11,17.11,24.12,25.12,26.12")

=NAJÍT(HODNOTA.NA.TEXT(B3;"dd.mm");"01.01,06.01,"&HODNOTA.NA.TEXT(KČ(("4/"&ROK(B3))/7+MOD(19*MOD(ROK(B3);19)-7;30)*14%;)*7-8;"dd.mm,")&HODNOTA.NA.TEXT(KČ(("4/"&ROK(B3))/7+MOD(19*MOD(ROK(B3);19)-7;30)*14%;)*7-5;"dd.mm,")&"01.05,08.05,05.07,29.08,01.09,15.09,01.11,17.11,24.12,25.12,26.12")

Toto je navrhnuté pre to, ak nechcete žiadne skryté pomocné stĺpce, ale Vy tam už máte mesiace skryté, takže by ste mohol mať kľudne aj tie sviatky. Každopádne nezabudnite, že pri úprave PF musíte stáť na B3.

Prečo stále tvrdošijne trváte na FSO? Ten na to vôbec nieje vhodný, lebo by ste musel cyklom kontrolovať pri každom volaní všetky súbory v adresári po jednom. Čo je pomalé, hlavne pri viacnásobnom volaní z viacerých buniek. Použite obdobu Dir z príkladu, čo som Vám urobil minule presne na mieru. Tu máte jej úpravu na True/False.

Function FileExists(full_path As String)
Dim V, Pos As Integer, tmp() As String, Nazov As String

If full_path <> "" Then
tmp = Split(full_path, Application.PathSeparator)
Nazov = tmp(UBound(tmp))
Pos = InStrRev(Nazov, ".")
FileExists = Len(Dir(Left$(full_path, Len(full_path) - IIf(Pos = 0, 0, Len(Nazov) - Pos - 1)) & "*")) > 0
End If
End Function

Toto reaguje plne dynamicky, pridávanie hlavných kategórií aj podkategórií, premenovanie. Netreba udržiavať Definované názvy podľa kategórií. Nastavené Podmienené formátovanie pre overenie správnej voľby.

Proste sa to dá robiť mnohými spôsobmi...

Tak vzorcom vylúčte víkendy a basta. Upravil som len prvé 2 tbl.

A) To preto, že ste si nevšimol, že používam kódové meno listu. Je nezávislé na názve listu na jeho ušku. Ale môžete používať aj to namiesto wsSeznam dáte Worksheets("Seznam")

B) Neviem, či rozumiem. Vy chcete mať tlačítka v niekoľkých stĺpcoch a kopírovať list, ktorého meno je uvedené vedľa tlačítka vľavo ? V tom prípade iba upravíte začiatok hlavného makra. Viď príloha.

No a samozrejme, keď ste si vybral nejnevhodnejší variant, s potrebou úprav volacích makier, tak si pridaním tlačítok musíte ako som minule popísal urobiť zmeny (vytvoriť kópiu makra, priradiť správne makro správnemu tlačítku, pomenovať ...)

Možno by pre Vás bolo vhodnejšie, ak by ste mal názov listu rovno na tlačítku, a vo volacích procedúrach jednotlivých tlačítok by bolo napevno namiesto Application.Caller zadané meno listu. Potom samozrejme aj maličká úprava jednej premennej v hlavnom makre.
Začiatok makra by potom vyzeral
Sub ExportList(JmenoListu As String, Vzorce As String, Mazat As String)
Dim NewWB As Workbook, Radku As Long, Posun As Long, SloupceVzorcu() As String, SloupceMazat() As String, i As Integer, rngMazat As Range

If ListExist(JmenoListu) Then 'Kontrola existencie listu, pre prípad nesprávneho zápisu v stĺpci A
...
a volacie makrá
Sub Export1() 'Tlačítko 1
ExportList "AAA", "E,G", "L,M"
End Sub
a obdobne

PS: Zošit obsahoval 3308 nefunkčných Definovaných názvov!

Ešte som urobil úpravu, aby v prípade, že nebude uvedená prípona a zároveň nadradený adresár bude obsahovať bodku, nepovažoval aj časť názvu adresára za príponu. Teraz je fuk, či máte názvy s príponou, bez, aj či je v názve adresára bodka.
Sub CheckExists()
Dim rngRed As Range, rngGreen As Range, ARE As Range, Oblast As Range, Cell As Range, V, Pos As Integer, tmp() As String, Nazov As String, Separator As String

Set Oblast = Intersect(ActiveSheet.UsedRange, Selection)
If Oblast Is Nothing Then MsgBox "Žiadne data": Exit Sub

Separator = Application.PathSeparator

For Each ARE In Oblast.Areas
For Each Cell In ARE.Cells
V = Cell.Value
If Not IsEmpty(V) Then
tmp = Split(V, Separator)
Nazov = tmp(UBound(tmp))
Pos = InStrRev(Nazov, ".")
If Len(Dir(Left$(V, Len(V) - IIf(Pos = 0, 0, Len(Nazov) - Pos - 1)) & "*")) = 0 Then AddColor rngRed, Cell Else AddColor rngGreen, Cell
End If
Next Cell
Next ARE

If Not rngRed Is Nothing Then rngRed.Font.Color = vbRed
If Not rngGreen Is Nothing Then rngGreen.Font.Color = vbGreen
End Sub

Urobil som Vám tam radšej aj kompletný popis makra.

No netuším čo s tým robíte, akú oblasť testujete, ale u mňa 100 súborov urobí za mrknutie oka. Rôzne druhy súborov XLSX, XLSM, MP3, ISO, JPG, TXT, TIB, FLAC, CSV, MP4, ... niekoľko vnorení adresárov, pomiešané 4 HDD ...

čo máte ako testovanú oblasť ? Snáď nie celý stĺpec ?

EDIT: Určite označujete celý stĺpec. Veď to je milión riadkov. Tak si namiesto Vašeho Selection dajte nejakú oblasť, alebo to aspoň najskôr vypodmienkujte, či to nieje prázdne

Sub CheckExists()
Dim rngRed As Range, rngGreen As Range, Cell As Range, V, Pos As Integer
For Each Cell In Selection.Cells
V = Cell.Value
If Not IsEmpty(V) Then
Pos = InStrRev(V, ".")
If Len(Dir(Left$(V, IIf(Pos = 0, Len(V), Pos - 1)) & "*")) = 0 Then AddColor rngRed, Cell Else AddColor rngGreen, Cell
End If
Next Cell
If Not rngRed Is Nothing Then rngRed.Font.Color = vbRed
If Not rngGreen Is Nothing Then rngGreen.Font.Color = vbGreen
End Sub

alebo najlepšie checkujte iba prienik Vašeho výberu Selection s obsadenou časťou listu

Sub CheckExists()
Dim rngRed As Range, rngGreen As Range, ARE As Range, Oblast As Range, Cell As Range, V, Pos As Integer
Set Oblast = Intersect(ActiveSheet.UsedRange, Selection)
If Oblast Is Nothing Then MsgBox "Žiadne data": Exit Sub

For Each ARE In Oblast.Areas
For Each Cell In ARE.Cells
V = Cell.Value
If Not IsEmpty(V) Then
Pos = InStrRev(V, ".")
If Len(Dir(Left$(V, IIf(Pos = 0, Len(V), Pos - 1)) & "*")) = 0 Then AddColor rngRed, Cell Else AddColor rngGreen, Cell
End If
Next Cell
Next ARE

If Not rngRed Is Nothing Then rngRed.Font.Color = vbRed
If Not rngGreen Is Nothing Then rngGreen.Font.Color = vbGreen
End Sub
2000 súborov mi to kontroluje asi 0,5 sekundy, a to pri označení celého stĺpca.

Tak vyskúšajte.
Skúšať výhradne na kópii súboru !

Ale samozrejme, veď nemáte vyplnené B. Ak v B nič nieje, pre dátum je to ako 0. a nultý dátum je samozrejme minimálny možný, preto ho nájde ako minimum. Minimálny dátum (teda dátum 0, aj keď je to nezmysel) je 0.1.1900.
Takže si adekvátne upravte :
Maticovo:
=MIN(IF((C3:C99999="")*(B3:B99999<>0);B3:B99999;FALSE))
=MIN(KDYŽ((C3:C99999="")*(B3:B99999<>0);B3:B99999;NEPRAVDA))
Nematicovo:
=AGGREGATE(15;6;B3:B99999/((B3:B99999<>"")*(C3:C99999=""));1)

Nomi: Tak povedzte, čo na tomto nefunguje.

JoKe: Zbežne na to pozerám, a pochybujem o funkčnosti podľa zadania. V bunke predsa bude názov aj s príponou. Ale hľadať má aj alternatívu, že bude mať súbor inú príponu. Musíte buď cez Left a InStrRev alebo Len+Split odstrániť príponu.

EDIT: Príklad:
Sub CheckExists()
Dim rngRed As Range, rngGreen As Range, Cell As Range, V, Pos As Integer
For Each Cell In Selection.Cells
V = Cell.Value
Pos = InStrRev(V, ".")
If Len(Dir(Left$(V, IIf(Pos = 0, Len(V), Pos - 1)) & "*")) = 0 Then AddColor rngRed, Cell Else AddColor rngGreen, Cell
Next Cell
If Not rngRed Is Nothing Then rngRed.Font.Color = vbRed
If Not rngGreen Is Nothing Then rngGreen.Font.Color = vbGreen
End Sub

Sub AddColor(ByRef rngDest As Range, Cell As Range)
If rngDest Is Nothing Then Set rngDest = Cell Else Set rngDest = Union(rngDest, Cell)
End Sub

=MIN(IF(C3:C8="";B3:B8;FALSE))
=MIN(KDYŽ(C3:C8="";B3:B8;NEPRAVDA))

Skúste do IF/KDYŽ pridať ešte tretí parameter FALSE/NEPRAVDA. To musí fungovať.

Prípadne nematicovo (zdroj YouTube):
=AGGREGATE(15;6;B3:B8/(C3:C8="");1)

A môže nastať, že systém v liste NC vypľuje menu, ktorá ešte v AC nieje, a bude ju treba pridať do listu AC? Ak áno, môže byť pridaný aj niekde medzi pôvodnými menami? Teda napr. medzi CZK a EUR by dalo novú menu USD? Ak áno, kam ju treba potom pridať? Na koniec za ostatné čo tam pôvodne boli, alebo ich posunúť?

Inak ak je v oboch listoch aj "Pôvodná cena" aj "Aktuálna cena" mi nepríde logické. Veď ak aktualizujem cenu, a je nejaká nová spĺňajúca podm., tak v AC predsa presuniem tú čo bola doteraz v "Aktuálna cena" do "Pôvodná cena", a namiesto "Aktuálna cena" vložím novú aktuálnu cenu z NC. Pretože tá čo bola pred aktualizáciou aktuálna sa stáva pôvodnou. A tu mi nesedí to, že v NC je položka "Pôvodná cena". Má sa naozaj aktualizovať aj pôvodná cena (nieje problém)?

Ešte to robiť nejdem, len si ujasňujem, či mi to zapadá do v hlave "načrtnutého" riešenia :)

Elnino chápe, ale Elnino tiež skoro vždy nájde nejaké nelogické či nevysvetlené zádrhely :)

- V nových cenách nieje pri artikli 1 cena 3, no v starom je. Znamená to, že sa táto cena u tohto artiklu v pôvodnom zozname zmaže, alebo sa jej precenenie len vynechá (ostane pôvodná)?

- Ak v nových bude artikel, ktorý v starých nieje, tak sa iba pridá na koniec?

- Ak daný artikel v starých neobsahuje druh ceny, ktorý je zadaný v nových, má sa táto cena k starému pridať na koniec vpravo, alebo vynechať ?

- Za identifikátor druhu ceny sa považuje nadpis v riadku 1 (B1, C1, D1 ...) teda "CENA 1", "CENA 2", "CENA 3" ... ? Alebo za identifikátor sa považuje číslo stĺpca ? Inak povedané, môžu byť nadpisy stĺpcov s novými cenami akokoľvek odlišné ako staré (pridané, ubrané, poprehadzované, ...) ?

...

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje