Jak zrychlit práci/výkon excelu

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

VOM
Level 1.5
Level 1.5
Příspěvky: 110
Registrován: srpen 10
Pohlaví: Muž

Jak zrychlit práci/výkon excelu

Příspěvekod VOM » 08 srp 2019 09:20

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
Guru Level 15
Guru Level 15
Příspěvky: 42845
Registrován: únor 12
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod petr22 » 08 srp 2019 09:25

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
Level 1.5
Level 1.5
Příspěvky: 110
Registrován: srpen 10
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod VOM » 08 srp 2019 09:59

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
Level 4
Level 4
Příspěvky: 1498
Registrován: leden 10
Pohlaví: Nespecifikováno

Re: Jak zrychlit práci/výkon excelu

Příspěvekod Zivan » 08 srp 2019 11:12

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

petr22
Guru Level 15
Guru Level 15
Příspěvky: 42845
Registrován: únor 12
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod petr22 » 08 srp 2019 11:15

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

guest
Pohlaví: Nespecifikováno

Re: Jak zrychlit práci/výkon excelu

Příspěvekod guest » 08 srp 2019 12:52

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.

Uživatelský avatar
Grander
Level 4
Level 4
Příspěvky: 1308
Registrován: leden 12
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod Grander » 08 srp 2019 12:55

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

guest
Pohlaví: Nespecifikováno

Re: Jak zrychlit práci/výkon excelu

Příspěvekod guest » 08 srp 2019 13:08

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.

petr22
Guru Level 15
Guru Level 15
Příspěvky: 42845
Registrován: únor 12
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod petr22 » 08 srp 2019 13:10

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

guest
Pohlaví: Nespecifikováno

Re: Jak zrychlit práci/výkon excelu

Příspěvekod guest » 08 srp 2019 13:11

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

petr22
Guru Level 15
Guru Level 15
Příspěvky: 42845
Registrován: únor 12
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod petr22 » 08 srp 2019 13:14

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

VOM
Level 1.5
Level 1.5
Příspěvky: 110
Registrován: srpen 10
Pohlaví: Muž

Re: Jak zrychlit práci/výkon excelu

Příspěvekod VOM » 08 srp 2019 15:52

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


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • PC za cca 75k, s OS, na práci
    od takhassis » 01 čer 2020 16:59 » v Rady s výběrem hardwaru a sestavením PC
    2
    335
    od phixion
    04 čer 2020 08:11
  • Notebook na hry a práci
    od Kohus » 18 lis 2019 17:42 » v Rady s výběrem hardwaru a sestavením PC
    7
    526
    od Azmir
    19 lis 2019 07:42
  • PC na práci s grafikou.
    od pdezert » 27 led 2020 08:51 » v Rady s výběrem hardwaru a sestavením PC
    9
    485
    od xbs
    28 led 2020 15:11
  • GPU pro praci se 4k videem
    od name66 » 24 říj 2019 11:35 » v Rady s výběrem hardwaru a sestavením PC
    3
    619
    od vuLva
    24 říj 2019 11:53
  • Notebook pro grafickou práci do 20k
    od Neral85 » 25 čer 2020 23:34 » v Rady s výběrem hardwaru a sestavením PC
    1
    144
    od petr22
    26 čer 2020 07:38

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: CommonCrawl [Bot] a 1 host