< návrat zpět

MS Excel


Téma: Pomalé makro na vypnutí filtrů, seřazení rss

Zaslal/a 10.2.2023 13:30

Ahoj všem,
prosím o pomos s úpravou pomalého makra (odemknutí listu, vypnutí všech aktivních filtrů, seřazení podle data sestupně (sloupec G2:G4001), zamknutí listu - (povoleno vše krom přidání/odebrání sloupců a řádků.

makro níže:

Sub VŠE()
'
' VŠE Makro
'

'
For x = 1 To 100000
a = a + Rnd - Rnd
Next x
Application.Calculation = xlCalculationManual
Worksheets("DATABAZE ZAMESTNANCU").Unprotect Password:="pekarna"
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=1
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=2
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=3
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=4
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=5
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=6
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=7
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=8
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=9
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=10
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=11
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=12
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=13
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=14
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=15
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=16
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=17
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=18
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=19
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=20
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=21
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=22
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=23
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=24
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=25
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=26
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=27
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=28
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=29
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=30
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=31
ActiveSheet.ListObjects("Tabulka1").Range.AutoFilter Field:=32
Range("A630").Select
ActiveWorkbook.Worksheets("DATABAZE ZAMESTNANCU").ListObjects("Tabulka1").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("DATABAZE ZAMESTNANCU").ListObjects("Tabulka1").Sort. _
SortFields.Add Key:=Range("Tabulka1[[#All],[Nástup]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("DATABAZE ZAMESTNANCU").ListObjects("Tabulka1"). _
Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=570
Range("A2670").Select
Worksheets("DATABAZE ZAMESTNANCU").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True, Password:="pekarna"
Application.Calculation = xlCalculationAutomatic
End Sub

Zaslat odpověď >

Strana:  1 2 3   další »
#054402
elninoslov
Skúste
Příloha: zip54402_zoradenie.zip (20kB, staženo 8x)
citovat
#054407
avatar

elninoslov napsal/a:

SkústePříloha: 54402_zoradenie.zip (20kB, staženo 5x)
Funguje perfektně. Moc děkujicitovat
#054408
avatar

elninoslov napsal/a:

SkústePříloha: 54402_zoradenie.zip (20kB, staženo 5x)

Ještě mám prosbu. Šlo by prosím makro poupravit, abych se vždy po spuštění tohoto makra dostal na poslední buňku ve sloupci B:B (příjmení, jméno)
Děkujicitovat
#054409
elninoslov
Pred
.Protect ...
dajte
Range("Tabulka1[příjmení, jméno]").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Selectcitovat
#054411
avatar

elninoslov napsal/a:

Pred
.Protect ...
dajte
Range("Tabulka1[příjmení, jméno]").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Select

Asi dělám něco špatně. Nefunguje...
Děkujicitovat
#054412
elninoslov
Šmarjá ... čo znamená "Nefunguje" ???citovat
#054413
avatar

elninoslov napsal/a:

Šmarjá ... čo znamená "Nefunguje" ???

před .Protect ... jsem doplnil o to co jste mi posílal a při aktivaci mi vyskočí chybová hláška a zastaví se to na tom co jsem doplňoval.

Sub VŠE() ' VŠE Makro
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

With Worksheets("DATABAZE ZAMESTNANCU")
.Unprotect Password:="pekarna"

With .ListObjects("Tabulka1")
If Not .AutoFilter Is Nothing Then .AutoFilter.ShowAllData

With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("Tabulka1[[#All],[Nástup]]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With

Range("Tabulka1[príjmení, jméno]").Find(What:="*", LookIn:=xlRangeValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Select
.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True, Password:="pekarna"
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Subcitovat
#054415
elninoslov
To Vážne? Akú chybu to napíše? To si myslíte, že som jasnovidec? Áno som! A stavím sa, že tam nemáte to, čo popisujete, že tam máte. Teda, že stĺpec v Tabuľke (nie tabuľke) sa volá "příjmení, jméno".
Příloha: zip54415_zoradenie.zip (22kB, staženo 5x)
citovat
#054416
avatar

elninoslov napsal/a:

To Vážne? Akú chybu to napíše? To si myslíte, že som jasnovidec? Áno som! A stavím sa, že tam nemáte to, čo popisujete, že tam máte. Teda, že stĺpec v Tabuľke (nie tabuľke) sa volá "příjmení, jméno".Příloha: 54415_zoradenie.zip (22kB, staženo 1x)

Myslím, že mám vše správně. zasílám PrtScr
Příloha: png54416_2023-02-11-16_16_45-window.png (35kB, staženo 12x)
54416_2023-02-11-16_16_45-window.png
citovat
#054418
elninoslov
a) Spúšťate to v tej mojej prílohe alebo vo Vašej ?
b) Verzia Office (rok, jazyk, 32/64 bit) ?
c) A ešte tú chybu, čo to hodí uveďte.

Pretože Office 2019 x64 SK Pro - bez problémov.citovat

Strana:  1 2 3   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

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.

Aktivní diskuse

odpocet a storno tl.

PavDD • 28.3. 8:53

odpocet a storno tl.

Začátečník • 26.3. 14:39

odpocet a storno tl.

PavDD • 26.3. 10:22

odpocet a storno tl.

elninoslov • 26.3. 7:50

odpocet a storno tl.

PavDD • 26.3. 7:26

odpocet a storno tl.

elninoslov • 25.3. 22:34

odpocet a storno tl.

Začátečník • 25.3. 15:09