< návrat zpět

MS Excel


Téma: Zrychlení makra rss

Zaslal/a 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
#026169
avatar
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: zip26169_excel-umi-byt-rychly.zip (41kB, staženo 50x)
citovat
#026182
elninoslov
@dakt
Skúste na tie vzorce toto
Příloha: rar26182_pomale-makro3.rar (21kB, staženo 39x)
citovat

Strana:  « předchozí  1 2

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