• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Zrychlení makra

Zaslal/a dakt 6.8.2015 15:20

Dobrý den,

nejsem zběhlý ve tvorbě maker, tak jsem vytvořil makro jednoduše. Určitě se dá zrychlit, protože na počítačích v síti makro trvá někdy i minutu. Můžete mi pomoct?
Jde tu hlavně o odkazování na buňky. Mám vytvořený list Zadání odkud kopíruji hodnoty do listu Přehled.

Děkuji

Sub Makro2()
'
' Makro2 Makro

' Zastavení makra v případě chybného textu v A12 nebo nevyplněného data/času
If Range("A12") = "Číslo operace neexistuje" Then
MsgBox "Číslo operace neexistuje. Zkontrolujte číslo operace nebo vykažte hodiny na operaci Ostatní a popište ji do poznámky."
ElseIf Range("A12") = "Tato operace je již ukončena!" Then
MsgBox "Zvolená operace byla již pro tuto zakázku ukončena. Zkontrolujte číslo operace a zakázky, nebo vykažte hodiny na operaci Ostatní a vložte popis do poznámky."
ElseIf Range("B6") = "Vyplňte číslo operace" Then
MsgBox "Zadejte číslo vykazované operace do buňky B5."
ElseIf Range("C8") = "Zadejte datum" Then
MsgBox "Zadejte datum vykazované operace do buňky B8."
ElseIf Range("C9") = "Zadejte hodiny" Then
MsgBox "Zadejte hodiny vykazované operace do buňky B9."

Else


' Vypnutí obrazovky -> zrychlení zápisu
Application.ScreenUpdating = False

' Odemčení aktivního listu (Přehled)
Sheets("Přehled").Select
ActiveSheet.Unprotect Password:="Heslo123"

' Přidání řádku
Sheets("Přehled").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

' Odemčení aktivního listu (Zadání)
Sheets("Přehled").Select
ActiveSheet.Unprotect Password:="Heslo123"

' Hodiny vykazuje
Sheets("Zadání").Select
Range("B3").Select
Selection.Copy
Sheets("Přehled").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Výrobní zakázka
Sheets("Zadání").Select
Range("B4").Select
Selection.Copy
Sheets("Přehled").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Číslo operace
Sheets("Zadání").Select
Range("B5").Select
Selection.Copy
Sheets("Přehled").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Činnost
Sheets("Zadání").Select
Range("B6").Select
Selection.Copy
Sheets("Přehled").Select
Range("K2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Operace
Sheets("Zadání").Select
Range("B7").Select
Selection.Copy
Sheets("Přehled").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C2").Font.Bold = False

' Datum
Sheets("Zadání").Select
Range("B8").Select
Selection.Copy
Sheets("Přehled").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Font.Bold = False

Sheets("Přehled").Select
Range("F2").Select
Selection.Copy
Range("O2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Font.Bold = False

' Měsíc
Sheets("Přehled").Select
datumPrace = Range("F2").Value
Sheets("Přehled").Select
Range("G2").Value = Month(datumPrace)

' Rok
Sheets("Přehled").Select
datumPrace = Range("F2").Value
Sheets("Přehled").Select
Range("L2").Value = Year(datumPrace)

' Hodiny
Sheets("Zadání").Select
Range("B9").Select
Selection.Copy
Sheets("Přehled").Select
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Font.Bold = False

' Datum zadávání
Sheets("Zadání").Select
Range("D1").Select
Selection.Copy
Sheets("Přehled").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Poznámka
Sheets("Zadání").Select
Range("B10").Select
Selection.Copy
Sheets("Přehled").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Ukončení-kopírování hodnoty
Sheets("Zadání").Select
Range("B11").Select
Selection.Copy
Sheets("Přehled").Select
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

' Operace+zakázka (skrytý sloupec v Přehledu)
Sheets("Přehled").Select
Range("D3").Select
Selection.Copy
Range("D2").Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Operace+zakázka+ukončeno (skrytý sloupec v Přehledu)
Sheets("Přehled").Select
Range("N3").Select
Selection.Copy
Range("N2").Select
ActiveSheet.Paste
Application.CutCopyMode = False

' Operace+ukončeno (skrytý sloupec v Přehledu)
Sheets("Přehled").Select
Range("P3").Select
Selection.Copy
Range("P2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("D2").Select

' Zamčení aktivního listu (Přehled)
ActiveSheet.Protect Password:="Heslo"

' Tlačítko ukončení-odškrtnutí
Sheets("Zadání").Select
Range("C11").Select
ActiveCell.FormulaR1C1 = "FALSE"

' Číslo operace; hodiny; poznámka-vymazání
Sheets("Zadání").Select
Range("B5").Select
Selection.ClearContents
Range("B9").Select
Selection.ClearContents
Range("B10").Select
Selection.ClearContents

' Zamčení aktivního listu (Zadání)
ActiveSheet.Protect Password:="Heslo123"

' Zvolení buňek po dokončení
Range("B5").Select

' Aktualizace kontingenční tabulky
ActiveWorkbook.RefreshAll


End If
End Sub

Zaslat odpověď >

---

Strana:  1 2   další »

marjankaj(6.8.2015 16:23)#026149

myslím, že by si to mohol zrýchliť, keby si dal prílohu. Píšeš, že máš vytvorený list, ale my nemáme. A asi si ho vytvárať nebudeme(a ani nevieme vytvoriť)

No ja by som vyhodil tie SELECTy.citovat

dakt(6.8.2015 16:30)#026150

marjankaj napsal/a:

myslím, že by si to mohol zrýchliť, keby si dal prílohu. Píšeš, že máš vytvorený list, ale my nemáme. A asi si ho vytvárať nebudeme(a ani nevieme vytvoriť)

No ja by som vyhodil tie SELECTy.

Dobrý den, soubor jsem nepřikládal, protože je propojený s dalším 5 soubory a nefungovalo by ani to zadávání (kam se tahají data z jiných sešitů).

Jakože mám např. místo Sheets("Přehled").Select

Range("F2").Select

Selection.Copy

Range("O2").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False


dát

Sheets("Přehled").Select

Range("F2").Copy

Range("O2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Bude to takhle fungovat?citovat

elninoslov(6.8.2015 16:36)#026151

Toto riešiť bez prílohy ... to je pre vešticu :)
Skúste takto nejak. Pokusy robiť zásadne na kópii súboru.

Příloha: 26151_pomale-makro.rar (18kB, staženo 27x)

citovat

marjankaj(6.8.2015 16:47)#026152

No keďže prílohy sa asi nedočkám(neviem či kopíruješ hodnoty alebo vzorce)
tak namiesto
Sheets("Přehled").Select
Range("F2").Copy
Range("O2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

By som dal
Sheets("Přehled").Range("F2").Copy sheets("Přehled").Range("O2")

Ale keď nevidím obsah listu tak je to iba také teoretizovanie.

Ale ten tvoj kód sa mi ani nechce čítať nie to ešte aj analyzovať.citovat

elninoslov(6.8.2015 17:11)#026153

Ešte by som to upravil na oveľa kratšiu verziu s menším počtom prestupov, ale práve som si uvedomil, že makro pomalé nieje. Pomalý bude ten ActiveWorkbook.RefreshAll
Ako píše, prepojených 5 súborov + KT.
Niekde sa tu už tuším povaľuje diskusia o optimalizovaní KT (to je mimo mňa).

Příloha: 26153_pomale-makro2.rar (19kB, staženo 26x)

citovat

dakt(6.8.2015 17:15)#026154

marjankaj napsal/a:

No keďže prílohy sa asi nedočkám(neviem či kopíruješ hodnoty alebo vzorce)
tak namiesto
Sheets("Přehled").Select
Range("F2").Copy
Range("O2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

By som dal
Sheets("Přehled").Range("F2").Copy sheets("Přehled").Range("O2")

Ale keď nevidím obsah listu tak je to iba také teoretizovanie.

Ale ten tvoj kód sa mi ani nechce čítať nie to ešte aj analyzovať.

Vytvořil jsem na rychlo ukázkový soubor. Vyplňují se pouze políčka v listu Zadání a pouze bílá.

elninoslov napsal/a:

Pomalý bude ten ActiveWorkbook.RefreshAll

Mám v souboru 4 kontingenční tabulky, které je potřeba aktualizovat. Neexistuje tedy nějaký jiný příkaz na aktualizaci?

Příloha: 26154_ukazka.zip (36kB, staženo 26x)

citovat

elninoslov(7.8.2015 1:00)#026156

Ešte miniúprava (a keď ja by som si nahradil Range za Cell). Skúste si dočasne vyradiť riadok ActiveWorkbook.RefreshAll a uvidíte, aký budete mať rozdiel.

A nepomohlo by pretiahnutie tých súborov z LAN k Vám na disk a aktualizovať data z disku? Ale to iba tápem...

Příloha: 26156_registrace-hodin.rar (30kB, staženo 26x)

citovat

dakt(7.8.2015 9:34)#026163

elninoslov napsal/a:

Ešte miniúprava (a keď ja by som si nahradil Range za Cell). Skúste si dočasne vyradiť riadok ActiveWorkbook.RefreshAll a uvidíte, aký budete mať rozdiel.

A nepomohlo by pretiahnutie tých súborov z LAN k Vám na disk a aktualizovať data z disku? Ale to iba tápem...

Děkuji Vám mnohokrát, hned jsem o něco chytřejší :)
Jediný problém mám se sloupcem D, N, P. Potřebuji, aby se mi vždycky z buňky pod ní zkopíroval vzorec, né hodnota. Šlo by to nějak pozměnit? Děkuji

Potřebuji soubor upravovat na síti, aby k němu měli přístup i ostatní uživatelé, kteří také dělají úpravy a vkládají nové hodnoty.citovat

marjankaj(7.8.2015 10:13)#026164

Jediný problém mám se sloupcem D, N, P. Potřebuji, aby se mi vždycky z buňky pod ní zkopíroval vzorec, né hodnota. Šlo by to nějak pozměnit? Děkuji
--------------------

napríklad aj takto
Range("d1").Formula = Range("d1").offset(1,0).Formula

alebo

Range("D2").Copy Range("d2").Offset(-1, 0)citovat

dakt(7.8.2015 11:06)#026167

marjankaj napsal/a:

napríklad aj takto
Range("d1").Formula = Range("d1").offset(1,0).Formula

alebo

Range("D2").Copy Range("d2").Offset(-1, 0)

A jak to můžu vložit sem?

aZad = .Range("B3:B11").Value
.Range("A2:P2").Value = Array(aZad(2, 1), aZad(3, 1), aZad(5, 1), aZad(1, 1), aZad(6, 1), Month(aZad(6, 1)), aZad(7, 1), Worksheets("Zadání").Range("D1").Value, aZad(8, 1), aZad(4, 1), Year(aZad(6, 1)), aZad(9, 1), .Range("N3").Value, aZad(6, 1), .Range("P3").Value)

Ani jeden z uvedených kódů mi v tom nefunguje.citovat

Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse