Příspěvky uživatele
< návrat zpět
Verzia OS a Office ?
OT: Ani nie. Chrbtica ...
Sub Import()
' Import dat z jiného souboru
Dim Cesta As String
Dim Soubor As String
Dim List As String
Dim Zdroj As String
Dim Nazev As String
Cesta = "C:\Users\Downloads"
Nazev = "Zdroj.xlsx"
List = "List1"
Soubor = Cesta & "\" & Nazev
If Dir(Soubor) = "" Then MsgBox "Soubor " & Soubor & " neexistuje!", vbCritical: Exit Sub
Zdroj = "='" & Cesta & "\" & "[" & Nazev & "]" & List & "'!"
With Sheets("List1").Range("A1:B2")
.Formula = Zdroj & "A1:B2"
.Value = .Value
End With
With Sheets("List1").Range("D3:E4")
.Formula = Zdroj & "D3:E4"
.Value = .Value
End With
End Sub
Sub Makro1()
Dim prvy As String, druhy As String, treti As String
Dim PocRia As Long
prvy = "A"
druhy = "G"
treti = "AW"
PocRia = 15
Range("A1").Value = prvy
Range("A2").Value = druhy
Range("A3").Value = treti
Union(Cells(1, prvy).Resize(PocRia), _
Cells(1, druhy).Resize(PocRia), _
Cells(1, treti).Resize(PocRia)).Select
End Sub
Mohla by to byť udalosť listu?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("D2"), Target) Is Nothing Then PageSetup.CenterHeader = Range("D2")
End Sub
ak je to počítaný vzorec, tak napr.
Private Sub Worksheet_Calculate()
PageSetup.CenterHeader = Range("D3")
End Sub
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.
Uživatelské menu
\nMenu
On-line nástroje
Formulář Faktura
Formulář Faktura IV
Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.
RSS nejnovější články