• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

Příspěvky uživatele

Ale o prekresľovaní, či ukazovateli priebehu tu nepadla zmienka. Len o statickom info o spracovaní.

Áno, takých 100 milisekúnd môže byť na obed fakt málo ...

V tom prípade vyskúšajte toto.
Function FileExists(full_path As String)
Dim tmp() As String, Nazov As String
Application.Volatile
If full_path <> "" Then
tmp = Split(full_path, Application.PathSeparator)
tmp = Split(tmp(UBound(tmp)), ".")
If UBound(tmp) < 1 Then Nazov = full_path Else Nazov = Left$(full_path, Len(full_path) - Len(tmp(UBound(tmp)))) & "*"
FileExists = Len(Dir(Nazov)) > 0
End If
End Function

Malo by stačiť pridať
Application.Wait (100)
a malo by to stačiť. Už sa mi nepodarilo viac navodiť, aby to Excel nestačil "zožrať".

Prílohu som vymenil v pôvodnom poste.

=TRIM(LEFT(RIGHT(SUBSTITUTE(B9;" ";REPT(" ";LEN(B9)));10*LEN(B9)); LEN(B9)))*1
=PROČISTIT(ZLEVA(ZPRAVA(DOSADIT(B9;" ";OPAKOVAT(" ";DÉLKA(B9)));10*DÉLKA(B9)); DÉLKA(B9)))*1

Príklady...

EDIT: Aktualizácia prílohy 12.9.2019 12:02

Ja keď si tu na skúšobných dátach urobím aj prehľady, tak či tak mi to kopíruje správne aj s prehľadmi s označenými bunkami, všetko. Musí byť zádrhel v tých Vašich súboroch, môžete mi jeden poslať neverejne na mail?

Ak ide len o to označenie či nascrolovanie, dá sa pridať jeden riadok
Application.Goto .Cells(1, 1), True
za riadkom
If Not rngMazat Is Nothing Then rngMazat.ClearContents 'Vymazanie hodnôt stĺpcov

Ak ide o zlé kopírovanie (rozmiestnenie a pod) musím vidieť reálny súbor.

Ach áno, samozrejme. Pretože, to som postoval iba upravenú procedúru CheckExists, vychádzajúcu z postu (5.9.2019 12:39). Rovnako ako aj ďalšie 2 úpravy (5.9.2019 14:45) vychádzajú z pôvodného postu (5.9.2019 12:39). V ňom je malá pomocná procedúra AddColor, ktorá je v ďalších upravených postoch nemenná. A zaujímavé, že po takej dobe a toľkých mojich úpravách zisťujem, že ste ich ani netestoval, lebo by Vám predsa tá AddColor chýbala aj v ostatných návrhoch. A načo sa tu potom snažím?

Slúži na pridanie bunky k ostatným zafarbovaným, aby sa nefarbilo po jednej, čo je pomalé, ale všetky naraz.

PS: Túto procedúrku nepotrebuje len môj posledný návrh, lebo ten nič nefarbí, vracia True/False.

No asi tomu stále nerozumiem, ale uvidíme...:
Private Sub btnZnovu_Click()
btnZnovu.BackColor = &H8000000F
Range("B1:B10").Formula = "=TODAY()+A1"
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zmena As Range
Set Zmena = Intersect(Range("A1:A10"), Target)
If Not Zmena Is Nothing Then
btnZnovu.BackColor = vbGreen
Zmena.Offset(0, 1).ClearContents
Set Zmena = Nothing
End If
End Sub

Hodnoty do A vkladá užívateľ alebo makro ?
JE PODSTATNÉ čo je to za operáciu! Robí niečo so stĺpcom A a B? Vypína EnableEvents ? ...
B môže užívateľ alebo iné makro meniť nezávisle na A?
Ak A mení užívateľ, tak za zmenu sa považuje akákoľvek zmena vyvolaná pomocou udalosti listu Worksheet_Change ? Teda aj zmena hodnoty na rovnakú hodnotu? Alebo iba zmena na inú hodnotu ako tam bola? To je zásadný rozdiel v spracovaní, lebo druhý variant vyžaduje odkladanie starých hodnôt do skrytého listu.
atď....
veľmi slabý popis

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!

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse