Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 1. 8. 2021 11:26:08

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Tipy na zrychlení makro výpočtů

Zdravím, chci se podělit s drobnými poznatky a třeba i se zeptat zda někdo nemá také nějaké nápada třeba jak donutit využívat více vláken procesoru a ne jen jedno jedniné.
_
Využívám denně spusty maker, hlavně na schovávání řádků nebo mazání řádku u několika tisícových řádků včetně obrázků a nedávno jsem zjistil jednoduchý trik, pustit danné makro na jiném listu třeba i prázdném kde je jasně v makru odkázáno že se makro má provádět na danném jiném listu než li jsem "oSheet=oDoc.Sheets(0)" Zrychlení je cca 10x smile
_
Ale i tak se ptám zda nevíte jak donutit aby makro využívalo více vláken CPU? Nebo jiný tip na zrychlení?

Offline

#2 1. 8. 2021 15:09:43

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Ono dost zpomaluje většinou vykreslování.


Lze otevírat celé okno skryté, pak ho zobrazit.

sub okno1
	dim oDoc as object, okno as object, prop(0) as new com.sun.star.beans.PropertyValue
		prop(0).Name="Hidden" : prop(0).Value=true 'otevřít skryté
	oDoc=StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, prop)
	msgbox "otevřeno skryté"
	okno=oDoc.CurrentController.Frame.ContainerWindow
	okno.Visible=true
end sub

To samé ale pro aktuální okno

sub okno2
	dim oDoc as object, okno as object
	oDoc=ThisComponent
	okno=oDoc.CurrentController.Frame.ContainerWindow
	msgbox "skrýt"
	okno.Visible=false
	msgbox "zobrazit"
	okno.Visible=true
end sub

Dále lze skrýt jen "vnitřek" Calcu. Ale pozor, bude to dál reagovat na stisklé klávesy nebo položky z menu.
K tomuto je asi nejlepší udělat si i nějaký ukazatel průběhu.

sub okno3
	dim oDoc as object, okno as object
	oDoc=ThisComponent
	okno=oDoc.CurrentController.Frame.ComponentWindow
	msgbox "skrýt"
	okno.Visible=false
	msgbox "zobrazit"
	okno.Visible=true
end sub

V Nástroje/ Možnosti/ LibreOffice/ OpenCL zapnout OpenCL. To umožní některé vícevláknové výpočty ale makra to nejspíš nezrychlí.


Nevím jestli je to dílem Libre nebo Windowsů, ale Libre mi běží snad vždy jen na jednom jádru, 100% vytížený procesor jsem od Libre viděl jen kdysi při nějakém bugu který byl v Calcu.


Basic je docela slabý ve smyčkách, když máte smyčku třeba se 100k+ opakování tak na to bývá rychlejší Python, někdy o dost rychlejší. Asi nejsnažší je nainstalovat si rozšíření od Mauricia Baezi https://gitlab.com/mauriciobaeza/zaz-ea … wikis/home a spouštět z Basicu jeho funkce.


A konkrétně v Calcu mnohdy bývá vůbec nejrychlejší použít UNO příkazy namísto příkazů z API Basicu tedy v podstatě jako kdybyste to naklikal z menu. Akorát k těm UNO příkazům se hodněkrát špatně hledají parametry, ale lze si je mnohdy zjistit přes Záznam makra. Některé parametry pro UNO příkazy jsou popsané zde https://thebiasplanet.blogspot.com/2018 … ables.html

Editoval kamlan (1. 8. 2021 16:12:15)

Offline

#3 1. 8. 2021 15:20:37

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,465

Re: Tipy na zrychlení makro výpočtů

barevnej napsal(a)

Zdravím, chci se podělit s drobnými poznatky a třeba i se zeptat zda někdo nemá také nějaké nápady třeba jak donutit využívat více vláken procesoru a ne jen jedno jediné.
_
Využívám denně spousty maker, hlavně na schovávání řádků nebo mazání řádku u několika tisícových řádků včetně obrázků a nedávno jsem zjistil jednoduchý trik, pustit dané makro na jiném listu třeba i prázdném kde je jasně v makru odkázáno že se makro má provádět na daném jiném listu než li jsem "oSheet=oDoc.Sheets(0)" Zrychlení je cca 10x smile
_
Ale i tak se ptám zda nevíte jak donutit aby makro využívalo více vláken CPU? Nebo jiný tip na zrychlení?

     To asi nepůjde, LibreOffice a stejně AOO neumí multitasking. Pracují jen s jediným vláknem, které samozřejmě přepínají podle spuštěných úloh, ale spuštěním více úloh naráz nic nezrychlíte. Časy se vlastně sčítají.
     Ještě detail makra lze spouštět jakoby "paralelně", ale jde to bez většího rizika pouze u maker, která neobsahují UNO. Když byste spustil makro v čistém Basic a druhé v UNO, tak byste splakal nad výsledkem.


     Pokud vím, tak zrychlit, znamená optimalizovat - odladit makro tak aby nedělalo zbytečné operace. Často znamená co nejvíce zjednodušit cykly a podmínky. Některé operace jako například vytváření a vybarvování rámečků jsou extrémně pomalé proti ostatním makrům.
     Například nejrychlejším cyklem je DO ... While, ale nedá se přerušit, proto se doporučuje DO ... LOOP, které se přerušit dá, ale málokdy stačí základní podmínka. Takže každé IF uvnitř cyklus děsně zpomaluje, a bývá lepší používat cyklu FOR ... NEXT, kde se například vnořuje více cyklů a každý může být zastaven samostatně, přičemž se čte vždy jen jedna podmínka. To je ale vyšší dívčí a já často potřebuji víc času k odladění, nežli k vlastní konstrukci makra a i tak zřejmě nedosáhnu plnou optimalizaci.
     Pro zrychlení cyklů, respektive odlehčení paměti je lepší podmínky vytáhnout mimo hlavní makro nejlépe do funkce. Funkce se provede - vyplivne výsledek a komp zapomene. Když je to účelné je nutno testovat koncepci - třeba vytažení funkcí, proti zjednodušení podmínek a cyklů.
     Znamená to většinou ladit stejné makro pro různé účely či množství dat. Nejlepší je použít vhodný algoritmus. Existují triky nejčastěi v podobě matematických vzorců, které lze zapracovat. Například pro zjišťování konvergence k Eulerovu číslu existují nejméně tři metody, já znám 4. Podobné je to s konstantou Pí. Tyto konstanty jsou sice zavedeny, ale když testujete konvergence, respektive aproximace, tak "hotové" konstanty nejsou k ničemu. Naposled jsem zrychlil asi 8x dík změně původně používané metody. Ale není pravidlo, že musíte zrychlovat za každou cenu. Někdy je prostě lepší spustit sady maker, které průběžně ukládají výsledky a jít na pivo, respektive pustit jiný počítač. Takže hraje úlohu i rozhodnutí co a jak potřebuji, nebo co jsem ochotný obětovat. Ladění může být časově náročnější, nežli makra na pomalo. Nejlepší je zabránit obnovování obrazovky makrem (celá obrazovka zmrzne), ale stačí srazit okno na lištu a nic nedělat - obnovuje se jen v rozumné míře. Při zmražení makrem nemáte informace co jak - není náhled a chce to vyřadit hlášky nejlépe výpisem do někam do listu - nebo i jiného dokumentu - a chyby přeskakovat. Hláška zabukuje bezpečně makro dokud ho operátor nepotvrdí. Prostě vše má svá pro a proti.

Editoval neutr (1. 8. 2021 15:29:25)


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#4 1. 8. 2021 18:55:07

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Ještě co se týká Calcu tak hodně urychlí naučit se používat com.sun.star.sheet.SheetCellRanges a metodu AddRangeAddress pro přidání skupiny buněk. Potom některé operace proběhnou o hodně rychleji než kdybyste to procházel buňku po buňce či řádek po řádku apod.

Sub obarviBunky 'obarví některé buňky
	on local error goto chyba
	dim oDoc as object, oRanges as object, oRangeAddress as new com.sun.star.table.CellRangeAddress
	oDoc=ThisComponent
	oRanges=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges") 'rozsahy vybraných buněk
	with oRangeAddress 'adresa přidávaného rozsahu
		.Sheet=0
		.StartColumn=0
		.EndColumn=0
	end with

	with oRangeAddress 'adresa přidávaného rozsahu
		.StartRow=0
		.EndRow=5
	end with
	oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah

	with oRangeAddress 'adresa přidávaného rozsahu
		.StartRow=10
		.EndRow=15
	end with
	oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah

	with oRangeAddress 'adresa přidávaného rozsahu
		.StartRow=20
		.EndRow=25
	end with
	oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah

	oRanges.CellBackColor=RGB(18,253,152) 'obarvit pozadí buněk v rozsahu
	exit sub
chyba:
	msgbox ("Chyba!" & chr(13) & Err & chr(13) & Error & chr(13) & "line: " & Erl,16,"obarviBunky")
End Sub

Editoval kamlan (2. 8. 2021 20:51:20)

Offline

#5 2. 8. 2021 09:40:25

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Je fakt že tomu úplně nerozumím a snažím se to lepit co to dá. Nejčastější makro co používám je tuším od jednoho z vás a to na schovávání řádků s nulovou hodnotou, navíc v těch řádcích jsou fotografie (1 až 3KiB), pokud jsem na danné kartě tak to trvá cca 3-5 minut, pokud jsem mimo kartu tak cca 45 vteřin.
_

Sub Schovat

Dim oCell as Object, oSheet as Variant, oSheets as Variant, oString as String

oSheets = ThisComponent.getSheets(0)
oSheet = oSheets.getByIndex(0)
oRows = oSheet.Rows

For i = 9 To 2000
oCell = oSheet.GetCellByPosition(28, i)
oRow = oRows.GetByIndex(i)
oString = oCell.getString()
If oString = "0" Then
  oRow.IsVisible = False
Else
  oRow.IsVisible = True
End If
Next i

End Sub

_
Jsou li nápady jak to ještě ještě zrychlit tak bych byl vděčný. Dělám to tak 30x denně.

Offline

#6 2. 8. 2021 14:33:05

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Skrýt řádky podle toho že je v nějakém sloupci nula by mělo jít rychle přes Standartní filtr.

Kdyžtak makro na filtry: https://www.openoffice.cz/doplnky/filtr … -v-bunkach

https://ask.libreoffice.org/en/question … -via-macro

Offline

#7 2. 8. 2021 18:59:19

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Zkuste tohle https://uloz.to/tamhle/nj1c0spnIpEb#!ZG … WDqI80MQV0

nejrychlejší u mně bylo třetí makro

Offline

#8 3. 8. 2021 11:26:31

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

WOW to je fakt luxusní, a ten progres je dokonalý smile
Chápu to správně že už nemusím být na jiném listě a funguje to stále stejně rychle?

Offline

#9 3. 8. 2021 11:32:25

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Mělo by to tak být, nemělo by být potřeba přepínat :-)

Offline

#10 3. 8. 2021 12:24:57

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Vím jsem otravný a i když jste to doknale popsal asi dělám někde chybu.
Upravil jsem (druhé makro z těch tří příkladů) viz makro co jsem psal nahoře, jen více řádků.
_

Sub skryjRadkyDleSloupce2 'pomocí com.sun.star.Sheet.SheetCellRanges + UNO pro skrýt označené řádky
	dim oDoc as object, oSheet as object, oRange as object, oRanges as object, oRangeAddress as new com.sun.star.table.CellRangeAddress, oEnum as object, o as object, data(), i&, iSloupec&, i1&, i2&, iSheet%, aSkryt as variant, oWindow as object
	dim oDlg as object, oPrubeh as object, oButton as object, iPrubeh&, bCancel as boolean 'pro ukazatel průběhu
	const iStep=30 : iPrubeh=0 'pro ukazatel průběhu
	
	oDoc=ThisComponent
	oWindow=oDoc.CurrentController.Frame.ComponentWindow
'	oWindow.Visible=false 'tohle kdyžtak skryje vnitřek okna Calcu
	
	iSheet=0 'číslo listu ve kterém skrývám
	iSloupec=28 'sloupec dle kterého budu skrývat (A=0, B=1 atd.)
	i1=9 : i2=3100 'testované řádky (první řádek=0, druhý=1 atd.)
	aSkryt=0 'hodnota pro kterou skrývám řádek (v případě řetězců třeba "0")
	
	oSheet=oDoc.Sheets(iSheet)
	oRanges=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges") 'rozsahy vybraných buněk
	with oRangeAddress 'sloupce přidávaného rozsahu
		.Sheet=iSheet
		.StartColumn=iSloupec
		.EndColumn=iSloupec
	end with
	
		rem ukazatel průběhu
		oDlg=progressBarInit(0, i2-i1, oDoc)
		oDlg.title="Fakt miluju rychlost :-)"
		oPrubeh=oDlg.getControl("Pprogress")
		oButton=oDlg.getControl("Pbutton")
	
	oRange=oSheet.getCellRangeByPosition(iSloupec, i1, iSloupec, i2) 'data ze sloupce dle kterého skrývám řádky
	data=oRange.getDataArray
	dim iZac&, iKon&, a as variant, b as boolean
	iZac=i1 : iKon=0 : b=false
	
	rem hlavní smyčka
	for i=lbound(data) to ubound(data)

			rem ukazatel průběhu
			iPrubeh=iPrubeh+1
			if iPrubeh=iStep then 'vykreslovat až po nějakém počtu kroků
				oPrubeh.value=i
				iPrubeh=0 'reset aktuálního počtu kroků
			end if
			if oButton.Model.state=1 then 'stisknuto Cancel v ukazateli průběhu
				bCancel=true
				exit for
			end if

		rem porovnávání hodnot a přidávání do oRanges
		a=data(i)(0) 'aktuální hodnota ze sloupce -- v ukázce jde o číslo; v případě řetězců třeba a=CStr(data(i)(0))
		if a=aSkryt then 'hodnota je skrývaná
			if iKon=0 then iZac=i+i1 'nemám žádný počet řádků tedy jde o první řádek rozsahu tak pamatuji číslo řádku
			iKon=iKon+1 'zvětšuji počet řádků které budu přidávat do rozsahu
			b=true 'až narazí na neskrývaný řádek tak přidá rozsah
		elseif b=true then 'řádek nemá hodnotu při které se skrývá
			with oRangeAddress 'řádky přidávaného rozsahu
				.StartRow=iZac
				.EndRow=iZac+iKon-1
			end with
			oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah
			iKon=0
			b=false
		else 'šlo o neskrývaný řádek takže začátek přidávaného rozsahu bude minimálně na dalším řádku
			iZac=iZac+1
		end if
	next i
	
		rem pro ukazatel průběhu
		if bCancel=true then 'stisknuto Cancel v ukazateli průběhu
			msgbox("Přerušeno")
			goto konec
		end if
	
	if iKon>0 then 'poslední řádky ještě mají být skryty
		with oRangeAddress 'řádky přidávaného rozsahu
			.StartRow=iZac
			.EndRow=iZac+iKon-1
		end with
		oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah		
	end if

	rem skrýt rozsahy přes UNO - rychlé
	oDoc.CurrentController.Select(oRanges) 'označit rozsahy
	dim document as object, dispatcher as object
	document=oDoc.CurrentController.Frame
	dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
	dispatcher.executeDispatch(document, ".uno:HideRow", "", 0, array()) 'UNO pro skrytí označených řádků
konec:
'	oWindow.Visible=true 'zobrazit skrytý vnitřek okna Calcu
	oDlg.dispose() 'deaktivovat ukazatel průběhu
End Sub

_
Bohůžel při pokusu o spuštění mě to hodí tuto chybu.
2021-08-03_13-21.png

Offline

#11 3. 8. 2021 14:28:47

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Už to mám, ještě mi chyběla ta spodní část UKAZATEL PRŮBĚHU smile

Mohl bych jetě poprosit úúúúplně stejnou věc ale aby ty řádky mazal, používám tyto dvě věci nejčastěji, mazání a schovávání.

Offline

#12 3. 8. 2021 14:49:07

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Pro smazání je uno příkaz "uno:DeleteRows" - zjištěno ze Záznamu makra. Takže pak nahradíte řádek dispatcher.executeDispatch(document, ".uno:HideRow", "", 0, array()) za dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, array())


Ale můžete si tam dát třeba dotazovací msgbox

	dim iMsg%
	iMsg=msgbox("Ano - Schovat" & chr(13) & "Ne - Smazat", 3)
	if iMsg=6 then 'Ano
		dispatcher.executeDispatch(document, ".uno:HideRow", "", 0, array()) 'schovat označené řádky
	elseif iMsg=7 then 'Ne
		dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, array())	'smazat označené řádky
	end if

Offline

#13 3. 8. 2021 15:40:09

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Ještě si můžete aktualizovat tu inicializační funkci pro ukazatel průběhu aby se vycentroval v okně Libre :-)

rem UKAZATEL PRŮBĚHU - zobrazuje se ve středu okna Libre
Function progressBarInit(min&, max&, optional oDoc as object) as object 'vrátí objekt dialogového okna; při chybějícím oDoc ho přichytí k Desktopu
	on local error goto chyba
	dim oDlg as object, oDlgModel as object, oButtonModel as object, oProgress as object, oWindow as Object
	dim oSize as object, oSiz as new com.sun.star.awt.Size, koef as double
	const iDlgWidth=140, iDlgHeight=45 'bacha, nejde o pixely jako kdyby se vytvářelo dialogové okno v Basic editoru a pak volalo; dále je pro vystředění okna použita metoda convertSizeToPixel a nastavena proměnná koef

	rem model dialogového okna
	oDlgModel=CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
	with oDlgModel
		.Width=iDlgWidth
		.Height=iDlgHeight
	end with

	rem ukazatel průběhu
	oProgress=oDlgModel.createInstance("com.sun.star.awt.UnoControlProgressBarModel") 'objekt ukazatele průběhu
	with oProgress
		.Name="Pprogress" 'jméno pro makro
		.ProgressValueMin=min 'minimum
		.ProgressValueMax=max 'maximum
		.ProgressValue=0 'aktuální hodnota
		.Width=120
		.Height=15
		.positionX=10
		.positionY=5
		.Border=3 'rámeček
	end with
	oDlgModel.insertByName("Pprogress", oProgress) 'přidat do modelu
	
	rem tlačítko Zrušit
	oButtonModel=oDlgModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
	with oButtonModel
		.Name="Pbutton"
		.Width=40
		.Height=15
		.PositionX=50
		.PositionY=25
		.Label="Zrušit"
		.PushButtonType=com.sun.star.awt.PushButtonType.STANDARD
		.TabIndex=0
		.Toggle=true 'aktivace detekce vlastnosti State tlačítka
	end with
	oDlgModel.insertByName("Pbutton", oButtonModel)

	rem vykreslení dialogového okna
	oDlg=CreateUnoService("com.sun.star.awt.UnoControlDialog") 'dialog
	oDlg.visible=false 'skrýt dialog ať neproblikává
	oDlg.setModel(oDlgModel) 'nastavit model dialogovému oknu

	rem přidat dialogové okno k oknu dokumentu nebo Desktopu
	oWindow=CreateUnoService("com.sun.star.awt.Toolkit") 'dialogové okno
	if isMissing(oDoc) then 'přidat k Desktopu - pozor, systém může po chvíli vypsat že program neodpovídá
		oDlg.createPeer(oWindow,null)
	else 'přidat okno k oDoc
		dim oToolkit as object
		oToolkit=oDoc.currentController.frame.containerWindow
		oDlg.createPeer(oWindow,oToolkit) 'spojení
	end if

	rem propočty na vystředění dialogového okna
	with oSiz 'rozměr z kterého budu přepočítávat koeficient pro usazení dialogového okna průběhu doprostřed
		.Width=iDlgWidth
		.Height=iDlgHeight
	end with
	koef=iDlgWidth / oDlg.convertSizeToPixel(oSiz, com.sun.star.util.MeasureUnit.APPFONT).Width 'koeficient pro korekci dialogového okna

	oSize=oDoc.CurrentController.Frame.ContainerWindow.GetPosSize 'rozměry okna Calcu
	with oDlgModel
		.positionX=fix(koef*(oSize.Width-iDlgWidth/koef)/2) 'pozice X od levého horního rohu okna; šířku dialogu je třeba brát zvětšenou koef, pozici X pak zmenšenou koef
		.positionY=fix(koef*(oSize.Height-iDlgHeight/koef)/2) 'pozice Y od levého horního rohu okna
	end with
	oDlg.visible=true 'zobrazit dialog
	progressBarInit=oDlg
	exit function
chyba:
	msgbox("Error " & Err & ": " & Error$ + chr(13) + "Line: " + Erl , 16 ,"progressBarInit")
End Function

Offline

#14 3. 8. 2021 16:39:17

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Vycentrování je super, děkuji moc.
Jinak už jsem aplikoval na největší ceník co mám včetně fotek 5900 řádků. Před tím to trvalo cca 7 minut, nyní 25 vteřin big_smile

Offline

#15 3. 8. 2021 17:06:52

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Poslední přání, potřebuji opak prvního makra, tj že potřebuje zase zobrazit skryté řádky které obsahovaly nuly. Vím že to jde označit řádky a pak dát zobrazit ale je to přeci jen pohodlnější přes tlačítko.

Offline

#16 3. 8. 2021 18:33:09

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Jde kliknout na písmeno s názvem sloupce, tím se označí celý sloupec a pak dát Formát/ Řádky/ Zobrazit. Následující makro to dělá. Akorát si v args1(0).Value="$D$1" dejte své písmeno sloupce.

Sub zobrazRadky 'zobrazí skryté řádky v daném sloupci (jako při označení sloupce a menu Formát/ Řádky/ Zobrazit)
	dim oDoc as object, oCell as object, document as object, dispatcher as object, o as object
	dim args1(0) as new com.sun.star.beans.PropertyValue
		args1(0).Name="ToPoint"	
		args1(0).Value="$D$1" '**************  do kterého sloupce jít s kurzorem **************		
	oDoc=ThisComponent
	rem přesun na buňku v požadovaném sloupci
	document=oDoc.CurrentController.Frame
	dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
	rem označit sloupec a zobrazit řádky
	oCell=oDoc.CurrentSelection 'buňka v definovaném sloupci
	o=oCell.Columns.getByIndex(0) 'celý sloupec
	oDoc.CurrentController.Select(o) 'označit celý sloupec
	dispatcher.executeDispatch(document, ".uno:ShowRow", "", 0, array()) 'zobrazit skryté řádky
	dispatcher.executeDispatch(document, ".uno:Deselect", "", 0, array()) 'odznačit výběr sloupce
End Sub

Ta zrychlení když se povedou tak je to fakt super, já měl zatím největší úspěch v Calcu z cca 25 minut na 15s -> v makrech pro ruční úpravu SFD souborů - to jsou zdrojáky fontů z programu FontForge. A ve Writeru z asi 3,5 hodiny na 3 minuty - s transkripcí arabštiny. Akorát nedávno jsem zjistil, že když bude arabský text dlouhý a nebudou v něm žádné odřádkování ale bude vše v jednom odstavci, tak se to může transkribovat zase několik hodin. Ale už jsem přišel na to jak tam holt natvrdo naflákat Entery a holt to v rámci rychlosti prostě natvrdo překopat do více odstavců aniž by se mi změnilo zarovnání nebo rozestupy řádků, čímž se to zase (alespoň doufám) zrychlí do řádu pár minut :-).

Editoval kamlan (3. 8. 2021 18:35:13)

Offline

#17 4. 8. 2021 08:59:19

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Mockrát děkuji, vše postupně testuji. To zobrazování řádků je bleskové SUPER smile
Teď jsem se zasekl na mazání. Předem nevím kde danná karta bude a tak jsem si řekl že dám na tvrdo jméno té karty ale to nějak nejde.

iSheet=Sheets.getByName("FAKTURA") 'číslo listu ve kterém skrývám

Říkám si zda by bylo možné toto: Smazat řádky bez ohledu na to kde daná karta je (buď podle jména nebo aktivní list) a jako bonus by bylo pokud by se před nebo po zpracování přesunula karta na pozici "0" prostě na začátek (je to z důvodu že to pak inportuje účetní program a ten umí číst z excelu pouze první list)
_

Sub NOVE_mazani 'pomocí com.sun.star.Sheet.SheetCellRanges + UNO pro skrýt označené řádky
	dim oDoc as object, oSheet as object, oRange as object, oRanges as object, oRangeAddress as new com.sun.star.table.CellRangeAddress, oEnum as object, o as object, data(), i&, iSloupec&, i1&, i2&, iSheet%, aSkryt as variant, oWindow as object
	dim oDlg as object, oPrubeh as object, oButton as object, iPrubeh&, bCancel as boolean 'pro ukazatel průběhu
	const iStep=30 : iPrubeh=0 'pro ukazatel průběhu
	
	oDoc=ThisComponent
	oWindow=oDoc.CurrentController.Frame.ComponentWindow
'	oWindow.Visible=false 'tohle kdyžtak skryje vnitřek okna Calcu
	
	iSheet=Sheets.getByName("FAKTURA") 'číslo listu ve kterém skrývám
	iSloupec=3 'sloupec dle kterého budu skrývat (A=0, B=1 atd.)
	i1=1 : i2=3100 'testované řádky (první řádek=0, druhý=1 atd.)
	aSkryt=0 'hodnota pro kterou skrývám řádek (v případě řetězců třeba "0")
	
	oSheet=oDoc.Sheets(iSheet)
	oRanges=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges") 'rozsahy vybraných buněk
	with oRangeAddress 'sloupce přidávaného rozsahu
		.Sheet=iSheet
		.StartColumn=iSloupec
		.EndColumn=iSloupec
	end with
	
		rem ukazatel průběhu
		oDlg=progressBarInit(0, i2-i1, oDoc)
		oDlg.title="Mažu nulové :-)"
		oPrubeh=oDlg.getControl("Pprogress")
		oButton=oDlg.getControl("Pbutton")
	
	oRange=oSheet.getCellRangeByPosition(iSloupec, i1, iSloupec, i2) 'data ze sloupce dle kterého skrývám řádky
	data=oRange.getDataArray
	dim iZac&, iKon&, a as variant, b as boolean
	iZac=i1 : iKon=0 : b=false
	
	rem hlavní smyčka
	for i=lbound(data) to ubound(data)

			rem ukazatel průběhu
			iPrubeh=iPrubeh+1
			if iPrubeh=iStep then 'vykreslovat až po nějakém počtu kroků
				oPrubeh.value=i
				iPrubeh=0 'reset aktuálního počtu kroků
			end if
			if oButton.Model.state=1 then 'stisknuto Cancel v ukazateli průběhu
				bCancel=true
				exit for
			end if

		rem porovnávání hodnot a přidávání do oRanges
		a=data(i)(0) 'aktuální hodnota ze sloupce -- v ukázce jde o číslo; v případě řetězců třeba a=CStr(data(i)(0))
		if a=aSkryt then 'hodnota je skrývaná
			if iKon=0 then iZac=i+i1 'nemám žádný počet řádků tedy jde o první řádek rozsahu tak pamatuji číslo řádku
			iKon=iKon+1 'zvětšuji počet řádků které budu přidávat do rozsahu
			b=true 'až narazí na neskrývaný řádek tak přidá rozsah
		elseif b=true then 'řádek nemá hodnotu při které se skrývá
			with oRangeAddress 'řádky přidávaného rozsahu
				.StartRow=iZac
				.EndRow=iZac+iKon-1
			end with
			oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah
			iKon=0
			b=false
		else 'šlo o neskrývaný řádek takže začátek přidávaného rozsahu bude minimálně na dalším řádku
			iZac=iZac+1
		end if
	next i
	
		rem pro ukazatel průběhu
		if bCancel=true then 'stisknuto Cancel v ukazateli průběhu
			msgbox("Přerušeno")
			goto konec
		end if
	
	if iKon>0 then 'poslední řádky ještě mají být skryty
		with oRangeAddress 'řádky přidávaného rozsahu
			.StartRow=iZac
			.EndRow=iZac+iKon-1
		end with
		oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah		
	end if

	rem skrýt rozsahy přes UNO - rychlé
	oDoc.CurrentController.Select(oRanges) 'označit rozsahy
	dim document as object, dispatcher as object
	document=oDoc.CurrentController.Frame
	dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
	dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, array()) 'UNO pro skrytí označených řádků
konec:
'	oWindow.Visible=true 'zobrazit skrytý vnitřek okna Calcu
	oDlg.dispose() 'deaktivovat ukazatel průběhu
End Sub








rem UKAZATEL PRŮBĚHU - zobrazuje se ve středu okna Libre
Function progressBarInit(min&, max&, optional oDoc as object) as object 'vrátí objekt dialogového okna; při chybějícím oDoc ho přichytí k Desktopu
	on local error goto chyba
	dim oDlg as object, oDlgModel as object, oButtonModel as object, oProgress as object, oWindow as Object
	dim oSize as object, oSiz as new com.sun.star.awt.Size, koef as double
	const iDlgWidth=140, iDlgHeight=45 'bacha, nejde o pixely jako kdyby se vytvářelo dialogové okno v Basic editoru a pak volalo; dále je pro vystředění okna použita metoda convertSizeToPixel a nastavena proměnná koef

	rem model dialogového okna
	oDlgModel=CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
	with oDlgModel
		.Width=iDlgWidth
		.Height=iDlgHeight
	end with

	rem ukazatel průběhu
	oProgress=oDlgModel.createInstance("com.sun.star.awt.UnoControlProgressBarModel") 'objekt ukazatele průběhu
	with oProgress
		.Name="Pprogress" 'jméno pro makro
		.ProgressValueMin=min 'minimum
		.ProgressValueMax=max 'maximum
		.ProgressValue=0 'aktuální hodnota
		.Width=120
		.Height=15
		.positionX=10
		.positionY=5
		.Border=3 'rámeček
	end with
	oDlgModel.insertByName("Pprogress", oProgress) 'přidat do modelu
	
	rem tlačítko Zrušit
	oButtonModel=oDlgModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
	with oButtonModel
		.Name="Pbutton"
		.Width=40
		.Height=15
		.PositionX=50
		.PositionY=25
		.Label="Zrušit"
		.PushButtonType=com.sun.star.awt.PushButtonType.STANDARD
		.TabIndex=0
		.Toggle=true 'aktivace detekce vlastnosti State tlačítka
	end with
	oDlgModel.insertByName("Pbutton", oButtonModel)

	rem vykreslení dialogového okna
	oDlg=CreateUnoService("com.sun.star.awt.UnoControlDialog") 'dialog
	oDlg.visible=false 'skrýt dialog ať neproblikává
	oDlg.setModel(oDlgModel) 'nastavit model dialogovému oknu

	rem přidat dialogové okno k oknu dokumentu nebo Desktopu
	oWindow=CreateUnoService("com.sun.star.awt.Toolkit") 'dialogové okno
	if isMissing(oDoc) then 'přidat k Desktopu - pozor, systém může po chvíli vypsat že program neodpovídá
		oDlg.createPeer(oWindow,null)
	else 'přidat okno k oDoc
		dim oToolkit as object
		oToolkit=oDoc.currentController.frame.containerWindow
		oDlg.createPeer(oWindow,oToolkit) 'spojení
	end if

	rem propočty na vystředění dialogového okna
	with oSiz 'rozměr z kterého budu přepočítávat koeficient pro usazení dialogového okna průběhu doprostřed
		.Width=iDlgWidth
		.Height=iDlgHeight
	end with
	koef=iDlgWidth / oDlg.convertSizeToPixel(oSiz, com.sun.star.util.MeasureUnit.APPFONT).Width 'koeficient pro korekci dialogového okna

	oSize=oDoc.CurrentController.Frame.ContainerWindow.GetPosSize 'rozměry okna Calcu
	with oDlgModel
		.positionX=fix(koef*(oSize.Width-iDlgWidth/koef)/2) 'pozice X od levého horního rohu okna; šířku dialogu je třeba brát zvětšenou koef, pozici X pak zmenšenou koef
		.positionY=fix(koef*(oSize.Height-iDlgHeight/koef)/2) 'pozice Y od levého horního rohu okna
	end with
	oDlg.visible=true 'zobrazit dialog
	progressBarInit=oDlg
	exit function
chyba:
	msgbox("Error " & Err & ": " & Error$ + chr(13) + "Line: " + Erl , 16 ,"progressBarInit")
End Function

Editoval barevnej (4. 8. 2021 09:12:03)

Offline

#18 4. 8. 2021 10:56:41

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Je potřeba otestovat existenci listu FAKTURA, to je na začátku a také se tam hned provede přesunutí listu na první pozici.


Když se maže přes .uno:DeleteRows tak je to nejrychlejší, ale musí to být prováděno v aktivním listu. List se aktivuje jednoduše příkazem oDoc.CurrentController.ActiveSheet=oSheet.
Přes API Basicu lze mazat vždy jen jeden rozsah buněk v listu metodou oSheet.removeRange (alespoň co já vím), takže to by bylo pomalejší - byť pak by to bylo naprosto nezávislé na tom který list je zrovna aktivní. Ale za to snížení rychlosti by se to asi nevyplatilo.

Sub NOVE_mazani 'pomocí com.sun.star.Sheet.SheetCellRanges + UNO pro skrýt označené řádky
	on local error goto chyba
	dim oDoc as object, oSheet as object, oRange as object, oRanges as object, oRangeAddress as new com.sun.star.table.CellRangeAddress, oEnum as object, o as object, data(), i&, iSloupec&, i1&, i2&, iSheet%, aSkryt as variant, sList$, oSheets as object
	dim oDlg as object, oPrubeh as object, oButton as object, iPrubeh&, bCancel as boolean 'pro ukazatel průběhu
	const iStep=30 : iPrubeh=0 'pro ukazatel průběhu
	
	oDoc=ThisComponent

	rem test existence požadovaného listu
	sList="FAKTURA" 'jméno listu
	oSheets=oDoc.Sheets 'listy sešitu
	if oSheets.hasByName(sList) then 'sešit list obsahuje
		oSheet=oSheets.getByName(sList) 'požadovaný list
		oSheets.moveByName(sList, 0) 'přesune list na první pozici (tenhle řádek se klidně může dát až na konec, tedy za dispatcher.executeDispatch)
		iSheet=oSheet.RangeAddress.Sheet 'číslo požadovaného listu
	else
		msgbox(sList, 48, "List neexistuje")
		exit sub
	end if
	
	iSloupec=3 'sloupec dle kterého budu skrývat (A=0, B=1 atd.)
	i1=1 : i2=3100 'testované řádky (první řádek=0, druhý=1 atd.)
	aSkryt=0 'hodnota pro kterou skrývám řádek (v případě řetězců třeba "0")
	
	oRanges=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges") 'rozsahy vybraných buněk
	with oRangeAddress 'sloupce přidávaného rozsahu
		.Sheet=iSheet
		.StartColumn=iSloupec
		.EndColumn=iSloupec
	end with
	
		rem ukazatel průběhu
		oDlg=progressBarInit(0, i2-i1, oDoc)
		oDlg.title="Mažu nulové :-)"
		oPrubeh=oDlg.getControl("Pprogress")
		oButton=oDlg.getControl("Pbutton")
	
	oRange=oSheet.getCellRangeByPosition(iSloupec, i1, iSloupec, i2) 'data ze sloupce dle kterého skrývám řádky
	data=oRange.getDataArray
	dim iZac&, iKon&, a as variant, b as boolean
	iZac=i1 : iKon=0 : b=false
	
	rem hlavní smyčka
	for i=lbound(data) to ubound(data)

			rem ukazatel průběhu
			iPrubeh=iPrubeh+1
			if iPrubeh=iStep then 'vykreslovat až po nějakém počtu kroků
				oPrubeh.value=i
				iPrubeh=0 'reset aktuálního počtu kroků
			end if
			if oButton.Model.state=1 then 'stisknuto Cancel v ukazateli průběhu
				bCancel=true
				exit for
			end if

		rem porovnávání hodnot a přidávání do oRanges
		a=data(i)(0) 'aktuální hodnota ze sloupce -- v ukázce jde o číslo; v případě řetězců třeba a=CStr(data(i)(0))
		if a=aSkryt then 'hodnota je skrývaná
			if iKon=0 then iZac=i+i1 'nemám žádný počet řádků tedy jde o první řádek rozsahu tak pamatuji číslo řádku
			iKon=iKon+1 'zvětšuji počet řádků které budu přidávat do rozsahu
			b=true 'až narazí na neskrývaný řádek tak přidá rozsah
		elseif b=true then 'řádek nemá hodnotu při které se skrývá
			with oRangeAddress 'řádky přidávaného rozsahu
				.StartRow=iZac
				.EndRow=iZac+iKon-1
			end with
			oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah
			iKon=0
			b=false
		else 'šlo o neskrývaný řádek takže začátek přidávaného rozsahu bude minimálně na dalším řádku
			iZac=iZac+1
		end if
	next i
	
		rem pro ukazatel průběhu
		if bCancel=true then 'stisknuto Cancel v ukazateli průběhu
			msgbox("Přerušeno")
			goto konec
		end if
	
	if iKon>0 then 'poslední řádky ještě mají být skryty
		with oRangeAddress 'řádky přidávaného rozsahu
			.StartRow=iZac
			.EndRow=iZac+iKon-1
		end with
		oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah		
	end if

	rem skrýt rozsahy přes UNO - rychlé - ale funguje jen v aktuálním listě
	dim document as object, dispatcher as object
	oDoc.CurrentController.ActiveSheet=oSheet 'požadovaný list jako aktivní aby v něm správně provedl uno příkaz
	oDoc.CurrentController.Select(oRanges) 'označit rozsahy
	document=oDoc.CurrentController.Frame
	dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
	dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, array()) 'UNO pro smazání označených řádků
konec:
	oDlg.dispose() 'deaktivovat ukazatel průběhu
	exit sub
chyba:
	msgbox("Řádek: " & Erl & chr(13) & "Chyba č. " & Err & chr(13) & Error, 16, "NOVE_mazani")	
End Sub

Offline

#19 4. 8. 2021 13:31:50

barevnej
Člen
Registrace: 6. 8. 2015
Příspěvků: 172

Re: Tipy na zrychlení makro výpočtů

Fakt luxusní, mockrát děkuji za úpravu makra na míru, zdá se že to funguje bez chyb. Snad to tu také pomůže někomu jinému.

Offline

#20 23. 8. 2021 00:17:34

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 844

Re: Tipy na zrychlení makro výpočtů

Pár poznámek:

Pokud má makro běžet rychle, tak je nezbytné:
1) Přepnout přepočet na manuální (i při skrývání řádků se rozbíhají některé výpočty, při mazaní se přepočty rozběhnou jistě (tedy pokud je na oblast navázán výpočet), i když ke změně dojde na jiném listu,
2) zakázat aktualizaci listu ("aktivovat jiný list" dělá něco podobného, ale není tak účinné a je to zbytečná komplikace)
3) Pracovat s co největšími bloky dat.
4) Omezit počet přístupů k objektům calcu
5) Preferovat jednoduché proměnné

V uvedených příkladu jsou všechny body opomíjeny.

Pokud je nutné smazat velký počet řádků, tak nejrychlejší je smazání v jednom bloku. Jeden blok se všemi řádky k smazání dostaneme jednoduše setříděním řádků podle sloupce s příznakem skrýt. (Je rozdíl mezi mazáním v jednom bloku a jedním příkazem. při mazání každého bloku dochází k přepočtu souvisejících adres a podle nastavení také k přepočtu vzorců.)




Jinak poslední ukázka obsahuje zbytečně moc proměnných pro hledání oblasti (Na těch pár řádcích není zřejmě dopad na výkon významný) :

dim iZac&, iPosun&, test as boolean, b as boolean

	rem hlavní smyčka

	b=false
	iPosun = i1 - lbound(data)

	for i=lbound(data) to ubound(data)

			rem ukazatel průběhu
			...  

		rem porovnávání hodnot a přidávání do oRanges

		test=data(i)(0) = aSkryt
		if test <> b then 'došlo ke změně v bloku
			b = test ' dál nám stačí jedna hodnota
			if test then ' začíná  blok pro skrytí (protože b bylo false)
				iZac = i ' uložíme začátek bloku
			else ' konec bloku pro skrytí (protože b bylo true, tak blok končí)
				with oRangeAddress 'řádky přidávaného rozsahu
					.StartRow=iZac + iPosun
					.EndRow=i+iPosun-1
				end with
				oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah
			end if
		end if
	next i
	if b then ' b je true, tj. poslední blok mažeme 
		... dokončit poslední blok

Editoval lp. (23. 8. 2021 00:27:08)

Offline

#21 23. 8. 2021 16:54:33

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

@lp.: 2) zakázat aktualizaci listu - to se prosím dělá jak?

Offline

#22 23. 8. 2021 18:36:36

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,465

Re: Tipy na zrychlení makro výpočtů

pro kamlan

     I když na mne dotaz nesměřuje. Pokusím se odpovědět. Celkem pochybuji, že se "lp." zase brzo objeví. Automatické aktualizace listu nejsou jako celkový pojem k dispozici. I když v nápovědě se dá najít jen pro Calc asi 15 různých pojmů ve spojení se slovem "automatické". Přestože "lp." uvedl jen jediný případ z těch všech. Je možné to pokládat jako množinu Global, která se promítá do všech modulů.


     Za aktualizace, automatické (bez opory v nápovědě) lze pokládat položky pod NÁSTROJE > MOŽNOSTI LO > NAČÍTÁNÍ A UKLÁDÁNÍ > OBECNÉ > AUTOMATICKY UKLÁDAT s implicitní volbou u mne 10 minut, ale v minulosti to bylo trošku jinde a lidé si s tím hráli tak, že nastavili pro těžké soubory časté ukládání, že se nestačilo uložit poprvé a už se ukládalo podruhé – výsledek pád, který z počátku fungoval, a pak když byl soubor větší – nestíhal a bylo po legraci. Nešel ani otevřít. „lp," si na to jistě pamatuje, ale je to už dost let.
     Podobná je nabídka pod SOUBOR > ZNOVU NAČÍST a ještě pod tím VERZE... a mohl si tyto dvě podobné funkce – tedy z nabídky NÁSTROJE a SOUBOR poplést.


     Mohl se splést ve formulaci myšlenky. Mohl myslet na aktualizaci obrazovky, která vyžaduje mnoho prostředků k vykreslování a rychlé obnově. Možná to jde z Expertních nastavení. Já osobně používám makro, které vypne obnovu obrazovky a určitě jsem to někde už uváděl. V Expertním nastavení jde mnoho věcí, které se v uživatelském menu jmenují jinak.


     Nakonec ještě uvedu, že "lp." není jen expertem na Calc, ale snad na všechny tabulkové procesory, nejméně Google a Excel všch verzí. Tam podobná funkce může být i v podobě, jakou neznáme a v nápovědě LO pochopitelně nedohledáme.


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#23 23. 8. 2021 22:36:17

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 844

Re: Tipy na zrychlení makro výpočtů

Vetšinou skoro automaticky používám:

	Doc = ThisComponent
	Doc.lockControllers()     ' zakáže aktualizaci obrazovky
	Doc.addActionLock()       ' zakáže přepočet

        ... výpočet ...

        Doc.removeActionLock()    ' povolí přepočet
        Doc.unlockControllers()   ' povolí aktualizaci zobrazení

Občas použiji také

        Doc = ThisComponent
        Doc.enableAutomaticCalculation(False)

        .................

        Doc.enableAutomaticCalculation(True)

(zakážu a povolím automatický přepočet)

Zamykání jednotlivých listů nepoužívám. (To byl překlep.)

Editoval lp. (23. 8. 2021 22:38:21)

Offline

#24 24. 8. 2021 13:02:50

kamlan
Člen
Registrace: 15. 9. 2016
Příspěvků: 368

Re: Tipy na zrychlení makro výpočtů

Dle postřehů lp. S tím setříděním to bylo při testování o hodně rychlejší, byť tedy nevím jak rychlé to bude o barevnýho. Je ale otázkou, zda-li když bude v mazacím sloupci víc hodnot než jen 0/1 (já zkoušel různě 0,1,2), tak zda to setřídění ve výsledku nebude vadit.

Sub LP_mazani 'setřídí a pak smaže úvodní blok který obsahuje nuly
	on local error goto chyba
	dim oDoc as object, oSheet as object, oRange as object, data(), i&, iSloupec&, i1&, i2&, aSkryt as variant, sList$, oSheets as object, bAutomatic as boolean, iSheet%, iEndColumn&
	'dim cas as date : cas=Now
	
	oDoc=ThisComponent
	bAutomatic=oDoc.isAutomaticCalculationEnabled 'jak je to aktuálně s automatickým přepočtem
	if bAutomatic then oDoc.enableAutomaticCalculation(false) 'kdyžtak deaktivovat automatický přepočet
	oDoc.lockControllers() 'zakáže aktualizaci obrazovky
	oDoc.addActionLock() 'zakáže přepočet

	rem test existence požadovaného listu
	sList="FAKTURA" 'jméno listu
	oSheets=oDoc.Sheets 'listy sešitu
	if oSheets.hasByName(sList) then 'sešit list obsahuje
		oSheet=oSheets.getByName(sList) 'požadovaný list
		oSheets.moveByName(sList, 0) 'přesune list na první pozici
		iSheet=oSheet.RangeAddress.Sheet 'číslo požadovaného listu
	else
		msgbox(sList, 48, "List neexistuje")
		exit sub
	end if
 
	iSloupec=3 'sloupec dle kterého budu mazat (A=0, B=1 atd.)
	i1=1 : i2=3000 'testované řádky (první řádek=0, druhý=1 atd.)
	aSkryt=0 'hodnota pro kterou skrývám řádek (v případě řetězců třeba "0")
	dim oCur as object
	oCur=oSheet.createCursor
	oCur.goToEndOfUSedArea(false)
	iEndColumn=oCur.RangeAddress.EndColumn 'poslední použitý sloupec v listu
	oRange=oSheet.getCellRangeByPosition(0, i1, iEndColumn, i2) 'data pro třídění od prvního sloupce do posledního použitého v daných řádcích

	rem setřídit obsah dle mazacího sloupce - dostanu tedy všechny řádky s nulou na začátek
	dim tridpodle(0) as New com.sun.star.util.SortField
	dim serad(0) as New com.sun.star.beans.PropertyValue
	tridpodle(0).Field=iSloupec
	tridpodle(0).SortAscending=True
	'tridpodle(0).FieldType = com.sun.star.util.SortFieldType.NUMERIC 'jde jen o čísla ve sloupci
	serad(0).Name="SortFields"
	serad(0).Value=tridpodle()
	oRange.sort(serad())	

	oRange=oSheet.getCellRangeByPosition(iSloupec, i1, iSloupec, i2)
	data=oRange.getDataArray() 'data z "mazacího" sloupce
	rem zjistit počet nul v mazacím sloupci
	dim bKonec as boolean
	if data(0)(0)=aSkryt then 'je alespoň jeden řádek který budu mazat
		dim aRange as new com.sun.star.table.CellRangeAddress 'rozsah pro smazání
		with aRange
			.Sheet=iSheet
			.StartColumn=0
			.StartRow=i1
			.EndColumn=iEndColumn
		end with
	 	if i2-i1>1 then 'mám v rozsahu alespoň dva řádky abych mohl porovnat jejich hodnoty
			i=0
			do 'spočítat kolik řádků se má smazat
				i=i+1 'počet řádků které se budou mazat
				bKonec=data(i)(0)=data(i-1)(0) 'když je řádek jiný než předchozí tak skončit
			loop while bKonec=true
			aRange.EndRow=i1+i-1 'poslední řádek v rozsahu pro smazání
		else 'jen jeden řádek pro smazání
			aRange.EndRow=i1
		end if
		oSheet.removeRange(aRange, com.sun.star.sheet.CellDeleteMode.UP) 'smazat řádky
	end if
		
	oDoc.removeActionLock() 'povolí přepočet
	oDoc.unlockControllers() 'povolí aktualizaci zobrazení
	oDoc.enableAutomaticCalculation(bAutomatic) 'původní nastavení automatického přepočtu
konec:
	'cas=Now-cas : msgbox Minute(cas) & ":" & Second(cas)
	exit sub
chyba:
	if NOT isNull(oDlg) then oDlg.dispose()
	msgbox("Řádek: " & Erl & chr(13) & "Chyba č. " & Err & chr(13) & Error, 16, "LP_mazani")	
End Sub

Ještě jde zjednodušit ta rovnice pro výpočet centrování ukazatele průběhu v předchozí ukázce .positionX=fix(...) ve Function progressBarInit.

	with oDlgModel
		.positionX=fix( (koef*oSize.Width-iDlgWidth)/2 ) 'pozice X od levého horního rohu okna; šířku dialogu je třeba brát zvětšenou koef, pozici X pak zmenšenou koef
		.positionY=fix( (koef*oSize.Height-iDlgHeight)/2 ) 'pozice Y od levého horního rohu okna
	end with


Ukázka od lp. s menším počtem proměnných pro zjišťování oblasti v příspěvku #20 funguje. Já věděl že ten algoritmus jsem měl složitěji a že to půjde jednodušeji, avšak nějak mi to tehdy nespínalo a tak jsem nad tím dále neuvažoval a nechal to prostě o něco složitější, hlavně že to fungovalo :-).


Tu konstrukci pro konverzi hodnoty výrazu do boolean proměnné test=data(i)(0)=aSkryt, či v současné ukázce bKonec=data(i)(0)=data(i-1)(0) jsem neznal, to je též dobrý zlepšovák. Objevil jsem to tedy i v Pitonyakově knize - ale jak je to celé v en, tak jsem tu knihu ani zdaleka nepročetl celou.


To oDoc.lockControllers() 'zakáže aktualizaci obrazovky a oDoc.addActionLock() 'zakáže přepočet jsem viděl v nějakém starém tipu ale bez vysvětlení, jen že je to pro zrychlení makra - avšak když jsem to zkoušel na pár mých ukázkách tak mi to nic nezrychlilo a tak jsem myslel, že to je nějaká zastaralá věc a nikdy to nepoužil :-).

Offline

#25 25. 8. 2021 23:17:55

lp.
Člen
Registrace: 24. 9. 2009
Příspěvků: 844

Re: Tipy na zrychlení makro výpočtů

Add třídění:
Doba potřebná na odstranění řádků závisí na počtu odstraňovaných souvislých bloků. Velikost bloku má podstatně menší vliv. Setřídění je pro mne nejjednodušší cestou, jak tyto nesouvislé řádky spojit do jednoho bloku. Tj. pokud se odstraňuje jen jeden řádek, tak se doba zvýší o režii třídění, pokud máme mnoho nesouvisejících řádků, tak naopak ušetříme. Na trik jsem přišel, když jsem dostal sešit, kde se střídaly řádky s daty s prázdnými.
Pomocí třídění můžeme dosáhnout dalšího zrychlení, např. lze mazané řádky přesunout na konec tabulky a blok hledat od konce - po smazání se nepřepočítávají odkazy na data na začátku tabulky a po odstranění bloku už další blok hledat nemusí.

add. zákaz aktualizace a přepočtu.
Záleží na okolnostech.
Při úpravě bloku bez propojení s výpočty je efekt minimální a po povolení přepočtu se přepočte sešit.
U větších tabulek s více výpočty může být efekt výrazný.

Používám u větších maker automaticky.

Offline

Zápatí