< návrat zpět

MS Excel

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

Zaslal/a Ontik 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ší »
elninoslov(10.2.2023 14:57)#054402
elninoslov
Skúste
Příloha: zip54402_zoradenie.zip (20kB, staženo 10x)
citovat
Ontik(10.2.2023 22:28)#054407
avatar

elninoslov napsal/a:

SkústePříloha: 54402_zoradenie.zip (20kB, staženo 5x)
Funguje perfektně. Moc děkujicitovat
Ontik(10.2.2023 22:47)#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
elninoslov(11.2.2023 11:06)#054409
elninoslov
Pred
.Protect ...
dajte
Range("Tabulka1[příjmení, jméno]").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Selectcitovat
Ontik(11.2.2023 13:36)#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
elninoslov(11.2.2023 14:32)#054412
elninoslov
Šmarjá ... čo znamená "Nefunguje" ???citovat
Ontik(11.2.2023 14:47)#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
elninoslov(11.2.2023 15:34)#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 6x)
citovat
Ontik(11.2.2023 16:18)#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 13x)
54416_2023-02-11-16_16_45-window.png
citovat
elninoslov(11.2.2023 17:27)#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

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

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.

On-line nástroje