< návrat zpět
MS Excel
Téma: Optimalizace, zrychlení 
Zaslal/a Začátečník 20.5.2016 21:23
Zdravím,
potřeboval bych nasměrovat, jak zrychlit zpracování makra. Bohužel nemohu uvést konkrétní příklad.
Sešit1 obsahuje zdrojové hodnoty
Sešit2 obsahuje doplňkové hodnoty
Funkcí SVYHLEDAT byly doposud ručně dotahovány data do sešitu1 do desítek sloupců ze sešitu2 (nepohodlné).
i = 2
While Cells(i, "B") <> Empty
row = Najdi_Data(wrkb_1, Cells(i, "B"))
If row = Empty Then
value = "#NENÍ_K_DISPOZICI"
Call Uloz_Data(i, "D", value)
Call Uloz_Data(i, "E", value)
Call Uloz_Data(i, "F", value)
Call Uloz_Data(i, "G", value)
Call Uloz_Data(i, "S", value)
Else
Call Uloz_Data(i, "D", Workbooks(wrkb_1).Worksheets("List1").Cells(row, "D"))
Call Uloz_Data(i, "E", Workbooks(wrkb_1).Worksheets("List1").Cells(row, "E"))
Call Uloz_Data(i, "F", Workbooks(wrkb_1).Worksheets("List1").Cells(row, "B"))
Call Uloz_Data(i, "G", Workbooks(wrkb_1).Worksheets("List1").Cells(row, "C"))
Call Uloz_Data(i, "S", Workbooks(wrkb_1).Worksheets("List1").Cells(row, "F"))
End If
i = i + 1
Wend
Private Sub Uloz_Data(row, col, value)
Cells(row, col) = value
End Sub
Private Function Najdi_Data(filename, value)
wrkb_act = ActiveWorkbook.Name
If Not Intersect(Cells(2, 2), Range("B:B")) Is Nothing Then
With Workbooks(filename).Worksheets("List1")
Set Nalezeno = .Cells.Find(what:=value, after:=Cells(2, 2), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
End With
If Not Nalezeno Is Nothing Then Application.Goto Nalezeno, True
End If
If Not Nalezeno Is Nothing Then
Najdi_Data = Nalezeno.row
End If
Workbooks(wrkb_act).Activate
End Function
Při stovkách řádků lze použít, ovšem při tisících řádků je již časově náročné.
Jak lze optimalizovat a zrychlit toto makro?
Děkuji za rady.
elninoslov(20.5.2016 21:47)#031579 
To bez prílohy dobre optimalizovať nepôjde.
Ide o to či nemôžete použiť na vyhľadávanie posledného riadku jeden stĺpec v ktorom viete že sú vždy dáta, takto prehľadávate všetko. Ďalej či sa dajú použiť polia (či ide o súvislé oblasti). Ďalej ide o zbytočnosti ako
If Not Intersect(Cells(2, 2), Range("B:B")) Is Nothing Then
To Vám nedá nikdy nič iné ako True, je to totiž bez premennej.
Alebo
Workbooks(wrkb_act).Activate
Pri prenášaní zo zošitu do zošitu nemusíte prepínať okná, zadefinujte si premenné
WBZdroj a WBCiel a odkazujte rovno na ne.
Ďalej použite na začiatku makra
Application.ScreenUpdating = False
a na konci
Application.ScreenUpdating = True
Prečo vôbec voláte "Uloz_Data" ? Veď to zapisujte rovno.
Na začiatku
Call Uloz_Data(i, "D", value)
...
Zapíšte to naraz v poli, napr. (teraz iba zbrucha) :
WBCiel.Cells(i,4).Resize(,4)=Array("#NENÍ_K_DISPOZICI","#NENÍ_K_DISPOZICI","#NENÍ_K_DISPOZICI","#NENÍ_K_DISPOZICI")
a do stĺpca S samostatne.
...
...
...
citovatZačátečník(20.5.2016 22:09)#031580 Zkusím vytvořit obdobu souborů.
Ano, jedná se o souvislou oblast dat, nejsou přerušena prázdnými řádky ani sloupci.
ScreenUpdating mám prozatím v originálu zakomentovaný, funkce pro uložení prozatím obsahuje i ladící procedury (proto její volání),
Ano, zapisování hodnot lze v některých případech ukládat v poli, ve většině však ne - nejsou souvislé oblasti.
Proměnné jsou definovány, jen sem do ukázky nebyly definice vloženy.
citovatxlnc(20.5.2016 22:57)#031581 
Kdybych byl pes, tak bych větřil.. užití SQL dotazu.
citovatDalda(20.5.2016 23:11)#031582 Zapisování do listu po buňkách, řádcích je u velkého objemu dat zdlouhavé. Obecný postup pro rychlé čtení a vkládání dat je přesun do nějaké paměťové struktury, nejlépe do pole. Pole pak projít a data vyčistit/dopracovat např. pomocí slovníku, který se hodí na odstraňování duplicit a vyhledávání pomocí klíče (je indexovaný). Osvědčil se mi postup přesypat data (u slovníku cyklem for each) zpět do polí (pro každý sloupec jedno pole) a přesunout data z pole po sloupcích do oblasti. U 600 000 řádků a 20 sloupců se vejdete do 5 min.
citovatZačátečník(22.5.2016 15:01)#031588 Pánové prozatím Vám děkuji za reakce, bohužel, vzhledem ke zdravotní indispozici, se pravděpodobně nebudu moci v nejbližších 4 týdnech problematice dále věnovat.
Později se ozvu.
citovat
RSS nejnovější články