Problemi di memoria

Hai un problema con Excel?

Nuova discussione

Problemi di memoria
di Fabio (utente non iscritto) data: 11/05/2015 23:31:53
Buonasera a tutti,
sto implementando un progetto che utilizza un codice piuttosto lungo.
L'ho diviso in più parti, richiamandole con la funziona Call.
Se avvio singolarmente le singole parti non ho problemi mentre se eseguo tutta la macro, ad un certo punto mi va in errore per un problema di memoria.
Sembra un problema di accumulo di consumo della memoria che si azzera se termino una singola parte con exit sub.
Esiste un sistema per azzerare (ad ogni singola parte) la memoria utilizzata?
Grazie e buona notte.
di Lucas87 data: 12/05/2015 08:56:58
Ciao
È possibile vedere il file?
di Fabio (utente non iscritto) data: 12/05/2015 12:55:50
Ciao Luca,
se fosse un semplice file non avrei problemi.
E' un file complesso (con 30 fogli) che estrae ed importa i dati da più di 300 file txt ed il primo (quello che mi crea problemi) a volte supera i 100 mb con più di 100.000 righe.
Mi interesserebbe molto un tuo parere, anche se rischio di offendere la tua professionalità visto come l'ho costruito (da incompetente - con il registratore e copiando o raccogliendo i vostri suggerimenti).
Buona giornata.
di Lucas87 data: 12/05/2015 13:45:43
Molto probabilmente, viste le dimensioni, ci saranno parecchie formule che si aggiorneranno con la modifica dei dati.
Potresti provare a impostare il ricalcolo del formule in manuale e metterlo in automatico alla fine.
Application .Calculation = xlManual Application .Calculation = xlAutomatic
di Fabio (utente non iscritto) data: 12/05/2015 13:50:36
No, ho pochissime formule attive. Quando uso le formule poi le elimino rendendo i dati definitivi.
Potrebbe essere un problemi dei dati che rimandono negli "appunti" per i deversi copia/incolla, nonostante utilizzo il comando Application.CutCopyMode = False?
Esiste un modo per eliminare gli appunti?
Grazie
di Lucas87 data: 12/05/2015 14:31:00
Application.CutCopyMode evita solo di mostrare la cornice tratteggiata attorno alle celle copiate.
Gli appunti vengono ripuliti dopo ogni copiatura, in excel addirittura vengono cancellati anche dopo altre operazioni. Non è quello il problema. Per verificare che non ci siano problemi nello svuotamento degli appunti, prova a usare molte volte il comando "copia" (senza incollare) su un file di grandi dimensioni, se non succede niente allora va tutto bene.

Quante celle copi?Ci sono formattazioni strane?
100Mb sono veramente tanti...controlla che le celle che non usi siano senza formattazione: seleziona la prima riga vuota, premi Ctrl+freccia giù, Modifica, Cancella tutto. Seleziona la prima colonna vuota, premi Ctrl+freccia destra, Modifica, Cancella tutto. Salva e controlla le dimensioni.

Se riesci prova a ricreare il file copiando su un file nuovo solo i valori e le formule.

Elimina qualche foglio e verifica se le dimensioni cambiano drasticamente.

Invece del copia/incolla che è lento e richiede di selezionare i fogli, si potrebbe provare a sostituirlo con la sintassi sotto, ma richiederebbe diverso lavoro.
Sheets(2).Range("a1:c2") = Sheets(1).Range("b1:d2").Value
di Lucas87 data: 12/05/2015 14:59:48
Per selezionare le righe e le colonne i comandi sono Ctrl+Shift+freccia giù e Ctrl+Shift+freccia destra
di Fabio (utente non iscritto) data: 12/05/2015 16:51:39
Innanzitutto grazie ancora per i suggerimenti.
Relativamente alla dimensione del file (superiore ai 100mb) mi riferivo al primo file txt da cui prendo i dati.
Il file di Excel va dai 3mb se è vuoto, ai 10-15mb quando è completo.
Buona serata.
di Lucas87 data: 12/05/2015 17:01:16
È comunque gigantesco...
di Fabio (utente non iscritto) data: 12/05/2015 17:33:11
ma quale, il file di excel o il file txt ?
di Lucas87 data: 13/05/2015 08:31:44
Il file excel...molto probabilmente ci sono formattazioni che non servono

di Fabio (utente non iscritto) data: 13/05/2015 13:57:00
Ciao Luca,
relativamente alle formattazioni, ce ne sono sicuramente per dare un aspetto "professionale" al file.
Farò una verifica se sono tutte indispensabili.
Per quanto riguarda il problema della memoria, allego un'immagine del punto dove va in errore con l'indicazione della "memoria esaurita".
Riporto anche un "blocco" del codice che utilizzo per estrarre i dati dal file txt e copiarli in excel.
Come ti dicevo, il file txt è enorme e quindi sono costretto ad estrarre i dati per "blocco".
Infatti uso 6 blocchi per estrarre quelli che mi servono.
L'esaurimento della memoria, si verifica al 4° "blocco" (quello dell'immagine)
Se anzichè avviare l'intera macro la eseguo per blocchi non mi crea problemi.
Evidentemete quando arriva a End Sub svuota la memoria.
La prima sub mi è stata gentimente creata da Lepat che ringrazio ancora tantissimo, mentre la seconda, come capirai, è opera mia e quindi non ti scandalizzare se vedi delle oscenità (al momento è quello che sono in grado di fare).
Qualsiasi suggerimento anche per migliorare il codice (e magari liberare memoria) è molto gradito.
Grazie

Sub APRI_FILE_GARANZIE_3()
        Dim sFile As String, S As String, res As String, l As Long, posend As Long, posini As Long
    'Memorizza Directory File.txt e Agenzia
        Application.CutCopyMode = False
        direct = Sheets("menu").Range("D4").Value
        AGE = Sheets("MENU").Range("D6").Value
    'Identifica percorso e nome file
        Director = Application.ActiveWorkbook.Path 'Percorso File
        Nome_File = Application.ActiveWorkbook.Name 'Nome File
        fpath = ThisWorkbook.Path & ""
        Nome_File_txt = "File_ridotto.txt" 'Nome File Txt
    'Memorizza nome file da Aprire
        Sheets("TAB").Select
        Dim NomeFile As String
        Nome_File_Originale_txt = Range("E3").Value
        RIGA = Range("G2").Value
        Nome_File_Originale_txt = Range("E" & RIGA).Value
     'Estrai dati e crea nuovo File Ridotto GARANZIE
        fpath = ThisWorkbook.Path & ""
        sFile = direct & "" & Nome_File_Originale_txt
        ofile = fpath & "File_ridotto.txt"
        i = FreeFile
        l = FileLen(sFile)
        res = Space(l)
        Open sFile For Binary Access Read As #i
        Get #i, , res
        Close i
        strSearch = Array("NXWEB_RISCHIO")
        strEnd = Array("NXWEB_PERSONA")
        For IND = 0 To 0
        posend = InStr(res, strEnd(IND))
        posini = InStr(res, strSearch(IND))
        S = S & Mid(res, posini, posend - posini)
        Next
        i = FreeFile
        Open ofile For Output As i
        Print #i, S
        Close
        sFile = fpath & "File_Ridotto.txt"
    'Apri File Ridotto
        Workbooks.OpenText Filename:=sFile, Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 2), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 2), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 2), Array(35, 1), Array(36, 2), Array(37, 1), Array(38, 2), Array(39, 1), Array(40, 2), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 2), Array(47, 1), Array(48, 1)), TrailingMinusNumbers:=True
        FileRidotto = sFile
        S = ""
    'Assegna Nome al file TXT aperto
        Nome_File_txt = Application.ActiveWorkbook.Name 'Nome File Txt
        Windows(Nome_File).Activate

Call DATI_GARANZIE_3
------------------------------------------------------------------
End Sub
Sub DATI_GARANZIE_3()
        On Error GoTo ERRORE_19
        Nome_File = Application.ActiveWorkbook.Name 'Nome File XLS
        Nome_File_txt = "File_ridotto.txt" 'Nome File Txt
 
 'Estrai CLASSI BM
        Windows(Nome_File_txt).Activate
        urR = Range("B4").End(xlDown).Row
        urB = Range("B4").End(xlDown).Row
        With Range("R4", "R" & urB) 'Incolla formula
        .FormulaR1C1 = "=IF(AND(RC16="""",RC17=""""),1,0)"
        .Value2 = .Value2
        End With
        Range("A3:AQ" & urB).Select
        Selection.Sort Key1:=Range("R3"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        If Range("R3").Value <> 0 Then GoTo NO_CLASSI0:    'Nessuna garanzia doppia da eliminare
        Range("R3", "R" & urB).Select
        Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        srB = ActiveCell.Address
        urR = ActiveCell.Row - 1
        
        Range("P3:Q" & urR).Copy
        Windows(Nome_File).Activate
        Sheets("CLASSI").Select
        Range("B65500").End(xlUp).Offset(1, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Windows("File_ridotto.txt").Activate
        Range("AK3:AK" & urR).Copy
        Windows(Nome_File).Activate
        Sheets("CLASSI").Select
        Range("B65500").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        Range("A" & prB, "A" & urB) = Range("A1")
        Range("A4", "D" & urB).Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
NO_CLASSI0:
    'Elimina Classi doppie
        urB = Range("B4").End(xlDown).Row
        Range("A4:D" & urB).Select
        Selection.Sort Key1:=Range("B4"), Order1:=xlAscending, Key2:=Range("A4") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
        With Range("F4", "F" & urB) 'Incolla formula
        .FormulaR1C1 = "=IF(RC2=R[1]C2,0,1)"
        .Value2 = .Value2
        End With
        Range("A4:F" & urB).Select
        Selection.Sort Key1:=Range("F4"), Order1:=xlDescending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        If Range("F" & urB).Value <> 0 Then GoTo NO_CLASSI1:    'Nessuna garanzia doppia da eliminare
        Range("F4", "F" & urB).Select
        Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        srB = ActiveCell.Address
        Range(srB, "F" & urB).Select
        Selection.EntireRow.Delete
        Range("F4:F" & urB).ClearContents
'YY:
        urB = Range("B4").End(xlDown).Row
        Range("A4:F" & urB).Sort Key1:=Range("B4"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        

NO_CLASSI1:
        Windows(Nome_File_txt).Activate
NO_CLASSI:
'--------------------------------------------------------------------------------------------------------

Vuoi Approfondire?