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
No ja by som vyhodil tie SELECTy.citovat
excel, návod, tipy, funkce, makra, vba, tabulky, šablony
Váš průvodce programem Microsoft Excel a programováním maker ve VBA
< návrat zpět
Téma: Zrychlení makra
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
Vytvořil jsem na rychlo ukázkový soubor. Vyplňují se pouze políčka v listu Zadání a pouze bílá.
Mám v souboru 4 kontingenční tabulky, které je potřeba aktualizovat. Neexistuje tedy nějaký jiný příkaz na aktualizaci?
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
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
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
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
Toto riešiť bez prílohy ... to je pre vešticu :)
Skúste takto nejak. Pokusy robiť zásadne na kópii súboru.
Skúste takto nejak. Pokusy robiť zásadne na kópii súboru.
Příloha: 
26151_pomale-makro.rar (18kB, staženo 27x)
citovat26151_pomale-makro.rar (18kB, staženo 27x)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
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
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).
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)
citovat26153_pomale-makro2.rar (19kB, staženo 26x)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)
citovat26154_ukazka.zip (36kB, staženo 26x)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...
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)
citovat26156_registrace-hodin.rar (30kB, staženo 26x)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
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
--------------------
napríklad aj takto
Range("d1").Formula = Range("d1").offset(1,0).Formula
alebo
Range("D2").Copy Range("d2").Offset(-1, 0)citovat
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
Uživatelské menu
Nejste přihlášen(a)
\n
\nMenu
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.
RSS nejnovější články