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é, ...) ?
...
Ani najväčším omylom to neodstráni všetku diakritiku. Ani len slovenskú nie (ŕ,ô,ľ,ĺ). O iných ani nehovorím (ń,ñ,ć...). Pozrite sa na Mapu znakov, koľko ich tam ešte je.
Vzorcom ? Stačí dať prepočítať list na karte Vzorce, a čísla sa zmenia. Alebo akákoľvek zmena v bunkách spôsobí prepočet čísel. Ak potrebujete presný opak, aby sa čísla neprepočítavali samé pri nejakej zmene, tak potom jedine makrom.
OT:
Darbujan: Presne s takýmito "popismi" sa často stretám, fantázia musí často len tak hučať, a tak som možno zvyknutý.
Alindros: Chvalabohu ste ani jedno netrafil. Tému som nezaložil ani nepamätám, Čaka zrovna nemusím, a ako Sheldon by som byť nechcel, ale mám ho rád
marjankaj: Hádať riešenie ? No, áno je to často lotéria :)
Tak toto sú prkotiny. Čo je horšie, že nemám elán/čas na komplikovanejšie veci čo som prisľúbil (a týmto sa aj ospravedlňujem tým čo som niečo rozpracoval/sľúbil a stále nič). Posledné 3-4 mesiace ... no bieda so mnou. Neviete zohnať pod rukou nejaký kryptonit ? Ten by bol asi v dnešnej dobe rozchytaný co-by-dup.
Áno, v tom prípade by to mohlo byť takto nejako:
=IF(ISERROR(SEARCH(","&A2&",";","&$C$1&","));"";B2)
=KDYŽ(JE.CHYBHODN(HLEDAT(","&A2&",";","&$C$1&","));"";B2)
a malo by to obsiahnuť všetky mysliteľné eventuality čo ma napadajú.
Si myslím, že som to uviedol správne, či nie ???
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.