Příspěvky uživatele

Podľa skladby je to moje makro, tak tu máte narýchlo úpravu.
-každé tlačítko na každom liste volá tú istú procedúru.
-podľa aktívneho listu sa určuje, o ktorý ide
-predpokladá sa, že na každom liste s tlačítkom je iba jedna Tabuľka. Resp. Tabuľka číslo 1 je tá o ktorú ide.

Tak skúste toto. Má to ale háčik. Nemôžete kontrolovať či ste iba vstúpil do bunky a potvrdil (nezmenil) hodnotu, alebo ste zadal inú. Museli by sa niekde kvôli tomu ukladať všetky hodnoty (skrytý list). Čiže Vám to tam pridá/zmení vždy.

Je už veľa hodín, tak pridám len kód, a logické veci, čo môžu nastať, nechám na zajtra. Napr. Čo s komentárom, ak sa bunka neaktualizuje, má sa mazať komentár? Alebo ak tam už je, má sa prepísať, alebo sa má text pripísať ...?

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

Příspěvky uživatele

Uživatelské menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje