Uveďte ešte verziu Office a jazyk, a aj OS.
Ja mám Office 2019 x64 Pro SK (1808), a Win 10 x64 Pro SK (1909). Nech to môže skúsiť pozrieť niekto, kto má rovnaké podmienky.
Skúste
Range("A2").AutoFilter Field:=1, Criteria1:=Format(Datum, "d.m.yyyy")
@ Stalker :
Kvôli rýchlosti prevedenia, by som na Vašom mieste zvážil "bleskovicu" s aplikovaním dočasného filtra spolu so SpecialCells, napr:
Sub VymazB3()
Dim Radku As Long
Application.ScreenUpdating = False
With Worksheets("List1")
'Počet řádků v A
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
If Radku = 1 Then Exit Sub
With .Range("A1:B" & Radku)
'Dočasně aplikovat filtr
.AutoFilter
.AutoFilter Field:=1, Criteria1:="=N"
On Error Resume Next
'Validní buňky v B smazat najednou
.Columns(2).Resize(Radku - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible).ClearContents
On Error GoTo 0
'Zrušit dočasný filtr
.AutoFilter
End With
End With
Application.ScreenUpdating = True
End Sub
Len teda A1:B1 musí byť hlavička.
Ale on sa neprehľadáva celý stĺpec, ale iba oblasť od 1. po posledný vyplnený riadok. Teda ak sú data od 1 po 80, tak 80 riadkov, ak od 1 po 530 tak 530 riadkov, ak od 1 po 780963 tak ...
Na rýchle určenie slúži tento riadok:
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
Bunka po bunke to proste dlho trvá, a stále sa to s časom spomaľuje. Rozdeliť to na menšie časti, a tie potom spojiť. Príklad:
Sub VymazB2()
Dim Radku As Long, i As Long, A(), rngB As Range, Counter As Long, cRngs As Long, tR() As Range
With Worksheets("List1")
'Počet řádků v A
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
'Načíst data do pole (pokud se načítá pole 1x1 je potřeba nastavit dimenzi)
If Radku = 1 Then ReDim A(1 To 1, 1 To 1): A(1, 1) = .Cells(1, "A").Value Else A = .Cells(1, "A").Resize(Radku).Value
'Cyklem projít pole
For i = 1 To Radku
'Kontrola na "n" i "N"
If StrComp(A(i, 1), "N", vbTextCompare) = 0 Then
Counter = Counter + 1
'Když obsahuje "n" nebo "N", přidej bunku B do oblasti na smazání
If rngB Is Nothing Then Set rngB = .Cells(i, "B") Else Set rngB = Union(rngB, .Cells(i, "B"))
If Counter = 1000 Then cRngs = cRngs + 1: ReDim Preserve tR(cRngs): Set tR(cRngs) = rngB: Set rngB = Nothing: Counter = 0
End If
Next i
End With
'Když oblast na smazání existuje, tak smazat najednou
If Counter + cRngs > 0 Then
For i = 1 To UBound(tR)
If rngB Is Nothing Then Set rngB = tR(i) Else Set rngB = Union(rngB, tR(i))
Next i
If Not rngB Is Nothing Then rngB.ClearContents
End If
End Sub
Sub VymazB()
Dim Radku As Long, i As Long, A(), rngB As Range
With Worksheets("Data")
'Počet řádků v A
Radku = .Cells(Rows.Count, "A").End(xlUp).Row
'Načíst data do pole (pokud se načítá pole 1x1 je potřeba nastavit dimenzi)
If Radku = 1 Then ReDim A(1 To 1, 1 To 1): A(1, 1) = .Cells(1, "A").Value Else A = .Cells(1, "A").Resize(Radku).Value
'Cyklem projít pole
For i = 1 To Radku
'Kontrola na "n" i "N"
If StrComp(A(i, 1), "N", vbTextCompare) = 0 Then
'Když obsahuje "n" nebo "N", přidej bunku B do oblasti na smazání
If rngB Is Nothing Then Set rngB = .Cells(i, "B") Else Set rngB = Union(rngB, .Cells(i, "B"))
End If
Next i
End With
'Když oblast na smazání existuje, tak smazat najednou
If Not rngB Is Nothing Then rngB.ClearContents
End Sub
Prisahám, že nerozumiem funkčnosti celého súboru. Ale terazky už mi fakt dochádza čas ... prchám.
Moje nervy. Celé zle! Teraz vás nekritizujem, pretože to asi neovládate, ja tiež neviem opraviť auto a mnoho ďalších vecí, ale v tom makre je dobrý asi len ten kúsok na rozloženie množstva, čo som robil kedysi tuším ja. Ten malý cyklus s poľom Rozlozene.
Všetko ostatné:
-nezmyselné rozsahy, raz po r. 100, potom 350, potom 42, a pritom je dní max 31, a počet alkoholu poznáte, teda x*31, alebo jedno xlUp
-priraďovanie premenných bez rozmyslu a bez správnej deklarácie. Nie toto nedeklaruje 2 premenné boolean:
Dim kk1, kk2 As Boolean
-zmätočné prepínanie medzi listami
-netuším prečo sa raz zisťuje počet riadkov v A, potom B, potom C, v tom istom liste
-neustále prepočítavanie počtu riadkov ich umiestnenia, neprišiel som na dôvod, navyše zistíte počet a aj tak vymažete riadok 5:100, načo potom ten počet?
-zmažete trange, a hneď pod tým kontrolujete či sa bunky v nej = ""
-kontrola buniek po jednej v cykloch, a zlých cykloch, keď kontroluje ďalej aj po nájdení.
-z názvov premenných nieje nijako priekazné, čo by mohli znamenať.
-chaotické vypĺňanie hotovej tabuľky
-nechápem čo znamenajú niektoré vstupné hodnoty, nedokázal som identifikovať prvotný význam, čo robia s makrom vidím.
-makro je absolútne neprehľadné - postráda tabulátory a zarovnania úrovní
-nieje tam jediný popis, čo by mala daná časť kódu robiť
-dlhé jednoprocedúrové makrá nikdy nebudú tak čitateľné ako parametrizované (to ešte neviem, či sa u Vás bude dať, toľko som to neanalyzoval)
-zbytočné cykly, napr. kontrola rozloženia, či boli rozložené nejaké údaje. Za jedno by sa nemusel alkohol vôbec vypisovať ak nebolo nič predané/rozložené, a za druhé ak už áno poznáme COUNT, COUNTA, COUNTIF, SUM, ...
a navyše
For tt = 1 To 16
? tam ich môže byť predsa viac.
-divné preformátovávanie
-načo slúži hodnota v D7 v listoch 1,2,...? Počet dní to nebude lebo síce 8-9.7 sú 2 dni, ale 1-7.7 nieje 8 dní.
To makro treba celé nie prekovať, ale znovu vytvoriť.
Celému tomu ale vôbec nerozumiem, čo to má ako robiť, prečo a za akých podmienok, ani čo má byť výsledkom. A to si nemyslím, že som v makrách nechápavý
Zatiaľ som sa pokúsil odchytať všemožné posuny, ale stále mi to nefachá tak ako by malo. V tom guláši mi niekde ešte niečo uniká. Uvažujem, či nieje menej času zabitého náhodou vytvorení úplne nového, ako hľadanie súvislostí a záludností v tomto. Každopádne mi dochádza trpezlivosť i čas. Takže zatiaľ Vám sem nič nedám, uvidíme večer ...
Ale nečudujte sa, že už len podľa toho, že sem tento súbor predkladáte aspoň po 5. krát, tak je jasné, že sa do toho komplikovaného gulášu nikomu asi moc nechce.
EDIT:
If cell2 Like nr Or cell2 Like nr2 Then
pravda = True
End If
A "pravda" sa už ďalej nespracováva. Takže na Pravde Vám už nezáleží ?
Tam treba pomeniť makrá dosť výrazne. Priložte ešte, ako má ten list "Tabulka B" vyzerať po úprave. Nieje mi jasné čo sa má posunúť. Či aj to "Kal.dni: Otvorené: Zatvorené:
", alebo až ten =SUM(C5:C350)..., alebo až "Deň Vodka Borovička Koniferka..."
Ono to samozrejme ide aj keď máte označenú oblasť. Ja som tým chcel len akcentovať, že záleží na polohe, ak sa používa relatívne adresovanie. Pozor potom na správne dopočítanie indexu. Teda to "ROW(...)-x"/"COLUMN(...)-x", kde to "x" je o jedno menšie ako prvé ROW()/COLUMN(). Aby vznikla na prvej bunke jednička v indexe.
Moje chabé nervy... To je taký problém, keď chcete upraviť makro, dodať súbor, ktorý korešponduje s tým makrom? V makre čarujete so stĺpcami 14, 16, 17 (N, P, Q). O takých príloha nechyruje. Výstup má prepísať pôvodný riadok? Spravím to tak, že zdroj bude A1:K1 a výstup bude A1:Kx.
EDIT: Teraz som si prešiel okom to Vaše makro. Vôbec nerobí to čo vravíte - to bude na niečo iné. Ono zlučuje hodnoty zo stĺpcov P a Q do P od 12 riadku pokiaľ nieje prázdny riadok v N. V 11. riadku má byť nejaká hlavička, a formátujete všetky dostupné riadky Excelu - to je špatne.
Pri zadávaní PF, musíte stáť na prvej bunke formátovanej oblasti, ak sa v PF používa relatívne adresovanie. A to sa tu používa. V tom druhom ste neskopíroval pravú zátvorku ")", a prílohu ste nedal.
"zmeny pozicii", "rozne tabulky", ... To je na každú tabuľku individuálne. Záleží kde začína, podľa toho ra vytvára index ten porovnávanej tabuľky (riadok/stĺpec). Pre každú zvlášť, alebo ak je v nich nejaký vzor možno sa dá dopočítať a použiť univerzál. Prílohu ...
Vy píšete o porovnaní listov, nie zošitov. V PF nepôjde takýto "cross-workbooks". To už potom asi iba makrom. Tam bude záležať na tom o koľko hodnôt pôjde, či použiť dolovanie dát cez bunku, cez otvorenie súboru, cez ExecuteExcel4Macro, cez ADO, ...
Fčuleky sa mi do toho moc nechce ... :(
Alebo si ťahať permanentne tie data z iného zošitu vzorcom do buniek v aktuálnom zošite niekam bokom a potom už PF ide.
Pr. PF:
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.