< návrat zpět

MS Excel


Téma: Pád Excelu po zaplnění paměti rss

Zaslal/a 6.3.2017 13:35

Dokázal by někdo poradit jak upravit makro tak aby využívalo méně systémových prostředků? Mám 64bit Win7 ale 32bit Excel. Makro jsou 2 cykly, jeden prochází cca 9000 řádků a na každém spustí cyklus který prochází dalších cca 2500 řádků v jiném listu. Porovnávají se záznamy a vkládají se odkazy na jiné soubory pomocí vzorců. Makro běží několik hodin ale nikdy nedoběhne protože se zaplní paměť (cca 1,6GB) a Excel zkolabuje, výsledek nelze uložit, nic.

Zaslat odpověď >

Strana:  1 2 3 4   další »
#035285
avatar
Bez přílohy?
P.citovat
#035286
avatar
Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

Dim sPath As String
sPath = "\\cesta\"

Dim lastrow As Long

On Error Resume Next

lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row - 1
y = 0
yy = 0
'ulozeno = 0

y = Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
End If

Dim i As Long
Dim test_cesta As String

For x = 2 To lastrow

For i = 1 To y
If Mid(Worksheets(jmeno2).Cells(x, 3), InStr(1, Worksheets(jmeno2).Cells(x, 3), "+") + 1, 1) = "H" Then
test_str = Left(Worksheets(jmeno2).Cells(x, 3), InStr(1, Worksheets(jmeno2).Cells(x, 3), "+") - 1)
Else
test_str = Worksheets(jmeno2).Cells(x, 3)
End If
If InStr(1, Worksheets("Data").Cells(i, 1), test_str) <> 0 Then
' test_cesta = Worksheets("Data").Cells(i, 2).Text
test_cesta = Worksheets("Data").Cells(i, 2).Text
test1 = GetInfoFromClosedFile(Replace(Worksheets("Data").Cells(i, 2), Worksheets("Data").Cells(i, 1), ""), Worksheets("Data").Cells(i, 1), "Summary", "A1")
If IsError(test1) Then
test3 = GetInfoFromClosedFile(Replace(Worksheets("Data").Cells(i, 2), Worksheets("Data").Cells(i, 1), ""), Worksheets("Data").Cells(i, 1), "List1", "A1")
If IsError(test3) Then
Worksheets(jmeno2).Cells(x, 15) = "xxx"
Else
jmeno_listu = "List1'!$Z$7"
Worksheets(jmeno2).Cells(x, 16).FormulaLocal = "=" & "'" & _
Left(test_cesta, InStrRev(test_cesta, "\")) & "[" & _
Right(test_cesta, Len(test_cesta) - InStrRev(test_cesta, "\")) _
& "]" & jmeno_listu
Worksheets(jmeno2).Cells(x, 16).Value = Worksheets(jmeno2).Cells(x, 16).Value * 3600
If Round(Val(Worksheets(jmeno2).Cells(x, 16)), 2) <> Round(Val(Worksheets(jmeno2).Cells(x, 13)), 2) Then
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(255, 0, 0)
Else
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(0, 255, 0)
End If
End If
Else
jmeno_listu = "Summary'!$J$13"
jmeno_listu2 = "Summary'!$O$12"
Worksheets(jmeno2).Cells(x, 15).FormulaLocal = "=" & "'" & _
Left(test_cesta, InStrRev(test_cesta, "\")) & "[" & _
Right(test_cesta, Len(test_cesta) - InStrRev(test_cesta, "\")) _
& "]" & jmeno_listu
Worksheets(jmeno2).Cells(x, 15).Value = Worksheets(jmeno2).Cells(x, 15).Value
Worksheets(jmeno2).Cells(x, 16).FormulaLocal = "=" & "'" & _
Left(test_cesta, InStrRev(test_cesta, "\")) & "[" & _
Right(test_cesta, Len(test_cesta) - InStrRev(test_cesta, "\")) _
& "]" & jmeno_listu2
Worksheets(jmeno2).Cells(x, 16).Value = Worksheets(jmeno2).Cells(x, 16).Value
' If Worksheets(jmeno2).Cells(x, 15).Value = "" Then
' Worksheets(jmeno2).Cells(x, 15).Value = 1
' Else
' Worksheets(jmeno2).Cells(x, 15).Value = Worksheets(jmeno2).Cells(x, 15).Value
' End If
If Round(Val(Worksheets(jmeno2).Cells(x, 16)) * Val(Worksheets(jmeno2).Cells(x, 15)), 2) <> Round(Val(Worksheets(jmeno2).Cells(x, 13)), 2) Then
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(255, 0, 0)
Else
Worksheets(jmeno2).Cells(x, 16).Font.Color = RGB(0, 255, 0)
End If
End If
DoEvents
Exit For
End If
Application.StatusBar = "3. (Checking of data) Progress: " & x - 1 & " of " & lastrow - 1 & ": " & Format((x - 1) / (lastrow - 1), "0%") & " | "
' Application.StatusBar = "Progress: " & Format((x - 1) / (lastrow - 1), "0%")
DoEvents
test_str = Nothing
test1 = Nothing
test3 = Nothing
Next i
' End If
DoEvents
Application.CutCopyMode = False
ThisWorkbook.Save
Next x

x = Empty
y = Empty
yy = Empty
lastrow = Empty

Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

ThisWorkbook.Save
End Sub


soubor dát nemůžu, obsahuje firemní data a linky na externí soubory, tzn. stejně by to nefungovalo.citovat
icon #035288
eLCHa
Nevím, jak se mi to stalo,ale i přes toto
soubor dát nemůžu, obsahuje firemní data a linky na externí soubory, tzn. stejně by to nefungovalo.

a přes to, že jste to ani nevložil do code

i přes to jsem se kouknul.

A řeknu vám, že tenhle kód nemůže jet několik hodin, ba dokonce ani minut a ani vteřin.

Takže tak nějak.citovat
#035303
avatar
To makro funguje jak jsem popsal, akorát jsem ho upravil abych ho sem mohl vložit.citovat
#035327
avatar
No pokud tady předhodíš vykuchaný kód, nemůžeš očekávat, že si někdo bude chybějíci řádky domýšlet.
Problém může být zrovna v nich.
A jen má doměnka:
GetInfoFromClosedFile() předpokládám, že ExecuteExcel4Macro()
No 9000 * 2500 * 2 ???
Do toho bych nešel.citovat
icon #035332
eLCHa
Nemůže fungovat.
Na začátku máte end if bez if.citovat
#035345
avatar
eLCHa, to je jasné, vždyť píše: akorát jsem ho upravilcitovat
#035346
avatar
Ani som sa nesnažil ten kód čítať.
Ale keď píšeš,že to funguje, tak v čom je potom problém?citovat
#035351
avatar
Koule moje křišťálová, zjev mi to zlo v kódu VBA...

No prej v tom kódu hrajete něco jako slovní fotbal. Přehazujete si texty, názvy a kdo ví, co ještě jako horký brambor. Asi dobrej koncept. Jo a nakonec se mi zjevila kapitola, jak Pejsek s kočičkou vařili dort. Pak koule potemněla a víc jsem z ní nedostal. Teda než zhasla, tak byla sprostá a viděl jsem sám sebe, jak si ťukám na čelo.

Ale je podstatné vědět, že paměť se zaplnila z 1,6 GB. Víte co, dejte ruce od Excelu a běžte pryč. Nejde o to, jak zčuněný je kód, ale že nepřemýšlíte hlavou, a jste schopen sem předhodit tenhle chuchvalec kódu a čekat zázrak. Padá hvězda, něco si přejte.citovat
#035353
avatar

xlnc napsal/a:

Koule moje křišťálová, zjev mi to zlo v kódu VBA...

No prej v tom kódu hrajete něco jako slovní fotbal. Přehazujete si texty, názvy a kdo ví, co ještě jako horký brambor. Asi dobrej koncept. Jo a nakonec se mi zjevila kapitola, jak Pejsek s kočičkou vařili dort. Pak koule potemněla a víc jsem z ní nedostal. Teda než zhasla, tak byla sprostá a viděl jsem sám sebe, jak si ťukám na čelo.

Ale je podstatné vědět, že paměť se zaplnila z 1,6 GB. Víte co, dejte ruce od Excelu a běžte pryč. Nejde o to, jak zčuněný je kód, ale že nepřemýšlíte hlavou, a jste schopen sem předhodit tenhle chuchvalec kódu a čekat zázrak. Padá hvězda, něco si přejte.


Tak tohle je nejhodnotnější příspěvek vůbec! Ne fakt, hrozně mi to pomohlo a život je hned lepší! 5

Tyhle kecy si nechte příště od cesty a věnujte čas něčemu užitečnějšímu, když už kritice, tak věcné a konkrétní, to co jste napsal ničemu/nikomu nepomůže...citovat

Strana:  1 2 3 4   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Prirazeni OnClick makra CommandButtonu pres VBA

Tex • 3.10. 1:57

Automatické dosazení KDYŽ

marjankaj • 2.10. 22:22

Automatické dosazení KDYŽ

PavelJ • 2.10. 21:54

Automatické dosazení KDYŽ

elninoslov • 2.10. 20:21

Automatické dosazení KDYŽ

PavelJ • 2.10. 19:55

Automatické dosazení KDYŽ

Stalker • 2.10. 19:23

Automatické dosazení KDYŽ

PavelJ • 2.10. 18:22