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

Aktualni verze Excelu vyuziva vsechna jadra.

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

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

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

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

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.

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

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ší.

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

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

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

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