• Ú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:  « předchozí  1 2

Vovka(7.8.2015 11:30)#026169

Zkuste si přečíst článek v příloze. Měl byste v něm najít dost inspirace, jak psát opravdu rychlé aplikace pro zpracování rozsáhlých dat v Excelu.

Příloha: 26169_excel-umi-byt-rychly.zip (41kB, staženo 50x)

citovat

elninoslov(8.8.2015 19:12)#026182

@dakt
Skúste na tie vzorce toto

Příloha: 26182_pomale-makro3.rar (21kB, staženo 40x)

citovat

Strana:  « předchozí  1 2

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

Formulář Faktura

Helios iNuvio

On-line nástroje