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
Jak zrychlit práci/výkon excelu
Re: Jak zrychlit práci/výkon excelu
Aktualni verze Excelu vyuziva vsechna jadra.
Pokud neni dokument vytvoren a pouzivan v nejake stare verzi, bude problem
v kodu a ne v Excelu.
Pokud neni dokument vytvoren a pouzivan v nejake stare verzi, bude problem
v kodu a ne v Excelu.
Re: Jak zrychlit práci/výkon 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
Mám zafajfkováno využívat všechna jádra, ale proč neběží procesor naplno prosím?
Milan
Re: Jak zrychlit práci/výkon excelu
Co je to hodne radku? 10 000 nebo milion? A co to makro dela? RAM neni plna?
HP Elitebook 845 G8 (Ryzen 5650U, 32GB RAM, WD SN570 1TB, 14" fullHD IPS) + HP USB-C G5 Essential + 29" LG 29UM65 + 22" Eizo S2202W
Re: Jak zrychlit práci/výkon excelu
Mozna kod bezi naplno, ale kdyz nam ho nechces ukazat, nelze posoudit co to ma
ma delat a jestli to funguje spravne.
ma delat a jestli to funguje spravne.
-
- Pohlaví:
Re: Jak zrychlit práci/výkon excelu
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.
Re: Jak zrychlit práci/výkon excelu
Ještě mě napadá, je ten Excel v 64 bit verzi?
-
- Pohlaví:
Re: Jak zrychlit práci/výkon excelu
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ší.
Naposledy upravil(a) guest dne 08 srp 2019 13:10, celkem upraveno 1 x.
Re: Jak zrychlit práci/výkon excelu
64bit Office ma smysl jen pokud dokument vyzere 2 GB RAM, zahlasi chybu "out of memory" a spadne.
-
- Pohlaví:
Re: Jak zrychlit práci/výkon excelu
Tlacháme tu úplně zbytečně. Buď autor ukáže kód, nebo to můžeme uzavřít.
Re: Jak zrychlit práci/výkon excelu
To jsem rikal hned na zacatku - tazatel chce vedet proc to funguje pomalu, ale neukaze nam co.
Re: Jak zrychlit práci/výkon excelu
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
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
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 1
- 1549
-
od newwes
Zobrazit poslední příspěvek
16 zář 2023 16:03
-
- 1
- 844
-
od zero
Zobrazit poslední příspěvek
19 črc 2023 13:43
-
- 14
- 1433
-
od nl635
Zobrazit poslední příspěvek
24 lis 2023 20:43
-
- 18
- 3580
-
od luko02420
Zobrazit poslední příspěvek
16 kvě 2023 11:27
-
-
Výběr noteboku na kancelářskou práci do 15.000,-
od deus.one » 23 říj 2023 20:45 » v Rady s výběrem hw a sestavením PC - 3
- 802
-
od deus.one
Zobrazit poslední příspěvek
04 lis 2023 08:24
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 6 hostů