Jak zrychlit práci/výkon excelu

[VOM]

Zdravím pěkně
Mám Excel soubor s hodně řádky. Makrem zpracovávám dost výpočtů. Excel je při tom velmi pomalý. Procesor je vytížen jen na několik %. Domnívám se, že je to tím, že ačkoliv má NB 8 jader tak VBA pracuje jen s jedním. Dá se to nějak donutit procesor pracoval naplno prosím?
Milan

[Reklama]

[petr22]

Aktualni verze Excelu vyuziva vsechna jadra.

Pokud neni dokument vytvoren a pouzivan v nejake stare verzi, bude problem
v kodu a ne v Excelu.

[VOM]

Nepochybuji, o tom, že kód by mohl být lepší.
Mám zafajfkováno využívat všechna jádra, ale proč neběží procesor naplno prosím?
Milan

[Zivan]

Co je to hodne radku? 10 000 nebo milion? A co to makro dela? RAM neni plna?

[petr22]

Mozna kod bezi naplno, ale kdyz nam ho nechces ukazat, nelze posoudit co to ma
ma delat a jestli to funguje spravne.

[guest]

Samo o sobě to jako celek nikdy nebude extra rychlé, nicméně si troufám říct, že Vás brzdí neefektivní kód, grafická stránka věci (překreslování obrazovky), události, přepočty listu apod.

[Grander]

Ještě mě napadá, je ten Excel v 64 bit verzi?

[guest]

64bit versus VBA nic neurychlí, naopak si naběhnete v případě API deklarací a dalšího. VBA na 64bit lidově řečeno kašle, i když se od verze 7.1 tváří, jako že je optimalizované. Microsoft udělal jen to nejnutnější.

[petr22]

64bit Office ma smysl jen pokud dokument vyzere 2 GB RAM, zahlasi chybu "out of memory" a spadne.

[guest]

Tlacháme tu úplně zbytečně. Buď autor ukáže kód, nebo to můžeme uzavřít.

[petr22]

To jsem rikal hned na zacatku - tazatel chce vedet proc to funguje pomalu, ale neukaze nam co.

[VOM]

mám Office 2019 32bit
paměť 16GB
řádků cca 8000

níže kód, který vyhledává kg ceny z dalších listů sešitu

Sub vloz_kg_ceny()
Dim i As Integer
Dim vzorec As String
Dim test_vyskytu As String
Dim pocet_radku As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("E10000").Select
Selection.End(xlUp).Select
Selection.Activate
pocet_radku = ActiveCell.Row
'Debug.Print pocet_radku
Range("K6 :" & "K" & pocet_radku).Clear

'ceny materiálů
For i = 9 To pocet_radku
' Debug.Print i
'Slozeni vzorce
vzorec = "=(INDEX(mat_costs!$A$2:$J$111;POZVYHLEDAT(E" + Str(i) + ";mat_costs!$A$2:$A$111;0);POZVYHLEDAT(G" + Str(i) + ";mat_costs!$A$1:$J$1;1)+1))/specification!$L$1"
' 'Odstraneni mezer
vzorec = Replace(vzorec, " ", "")
test_vyskytu = Application.WorksheetFunction.CountIf(Worksheets("mat_costs").Range("A1:A111"), Worksheets("specification").Cells(i, 5))
If test_vyskytu > 0 Then
' Worksheets("specification").Cells(i, 11).Value = "OK" 'vloží OK do sloupce K - z obou řádků komentář v zájmu zrychlení 8.8.2019
' Worksheets("specification").Cells(i, 11).Font.Color = 65280

Worksheets("specification").Cells(i, 9).FormulaLocal = vzorec
Worksheets("specification").Cells(i, 9).Copy
'Vlozeni hodnoty misto vzorce
Worksheets("specification").Cells(i, 9).Value = Round(Worksheets("specification").Cells(i, 9).Value, 2)
Application.CutCopyMode = False
Else: If Worksheets("specification").Cells(i, 5).Value <> "" And Worksheets("specification").Cells(i, 7).Value > 0 And Worksheets("specification").Cells(i, 26).Value = "" Then _
Worksheets("specification").Cells(i, 11).Value = "mat. CHYBÍ" 'vloží upozornění CHYBÍ do sloupce K
' Worksheets("specification").Cells(i, 11).Font.Color = 2500301
End If
Next i


' ceny elektro
Dim vzorec1 As String
Dim test_vyskytu1 As String
For i = 9 To pocet_radku
'Slozeni vzorce
vzorec1 = "=SVYHLEDAT(E" + Str(i) + ";ElekDrives!$A$7:$K$555;11;0)"
' 'Odstraneni mezer
vzorec1 = Replace(vzorec1, " ", "")
test_vyskytu1 = Application.WorksheetFunction.CountIf(Worksheets("elekdrives").Range("A1:A555"), Worksheets("specification").Cells(i, 5))
If test_vyskytu1 > 0 Then
' Debug.Print test_vyskytu1
' Worksheets("specification").Cells(i, 11).Value = "OK" 'vloží upozornění do sloupce K, z obou řádků komentář v zájmu zrachlení 8.8.2019
' Worksheets("specification").Cells(i, 11).Font.Color = 65280
Worksheets("specification").Cells(i, 10).FormulaLocal = vzorec1
Worksheets("specification").Cells(i, 10).Copy
'Vlozeni hodnoty misto vzorce
Worksheets("specification").Cells(i, 10).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Worksheets("specification").Cells(i, 11).Value = "=MATCH(RC[-6],ElekDrives!R1C1:R150C1,0)" ' vloží řádek z ceníku
' Worksheets("specification").Cells(i, 11).Value = "=MATCH(RC[-6],GearBoxes!R1C1:R150C1,0)" ' vloží řádek z ceníku

' Else: If Worksheets("specification").Cells(i, 5).Value <> "" And Worksheets("specification").Cells(i, 7).Value > 0 Then _
' Worksheets("specification").Cells(i, 11).Value = "mat. CHYBÍ" 'vloží upozornění CHYBÍ do sloupce K

'Else: If Worksheets("specification").Cells(i, 4).Value = "el" Then Worksheets("specification").Cells(i, 11).Value = "=MATCH(RC[-6],ElekDrives!R1C1:R555C1,0)"
'Worksheets("specification").Cells(i, 10).Font.Color = vbRed

End If
Next i

' ceny gearboxes
Dim vzorec2 As String
Dim test_vyskytu2 As String
For i = 9 To pocet_radku
'Slozeni vzorce
vzorec2 = "=SVYHLEDAT(E" + Str(i) + ";Gearboxes!$A$3:$K$555;11;0)"
' 'Odstraneni mezer
vzorec2 = Replace(vzorec2, " ", "")
test_vyskytu2 = Application.WorksheetFunction.CountIf(Worksheets("Gearboxes").Range("A:A"), Worksheets("specification").Cells(i, 5))
If test_vyskytu2 > 0 Then
' Debug.Print test_vyskytu2
'Worksheets("specification").Cells(i, 11).Value = "OK" 'vloží upozornění do sloupce K, z obou řádků komentář v zájmu zrachlení 8.8.2019
'Worksheets("specification").Cells(i, 11).Font.Color = 65280
Worksheets("specification").Cells(i, 10).FormulaLocal = vzorec2
Worksheets("specification").Cells(i, 10).Copy
'Vlozeni hodnoty misto vzorce
Worksheets("specification").Cells(i, 10).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' Else: If Worksheets("specification").Cells(i, 5).Value <> "" And Worksheets("specification").Cells(i, 7).Value > 0 Then _
' Worksheets("specification").Cells(i, 11).Value = "mat. CHYBÍ" 'vloží upozornění CHYBÍ do sloupce K
' Worksheets("specification").Cells(i, 11).Font.Color = 255
End If
Next i

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True
End Sub


Hezký den