ho fatto alcune subroutine e hanno lavorato molto in fase di test su 5 file, ma quando ho messo loro di lavorare su dati reali, che si trova a 600 file, dopo qualche tempo ricevo questo messaggio:Memoria mancanza di Excel VBA
Excel non può completare questa attività con le risorse disponibili. Scegli meno dati o chiudi altre applicazioni.
Googled e il più che ho trovato ero application.cutcopymode = false
, ma nel mio codice non sto usando taglio e modalità di copia, ma gestire la copia con
destrange.Value = sourceRange.Value
E quando vado a eseguire il debug Voglio dire, dopo la richiesta di errore, mi porta a questa stessa riga di codice. Se qualcuno ha riscontrato una situazione simile e sa come risolvere il problema, sarei grato.
Solo per rendermi chiaro ho provato application.cutcopymode = false
e non ha aiutato. Sto aprendo ognuno di questi 600 file, ordinati secondo criteri diversi e da ogni copia i primi 100 in una nuova cartella di lavoro (uno dopo l'altro) e quando finisco con un criterio, salvo e chiudo quella nuova cartella di lavoro e apro nuova e continuo ad estrarre i dati criteri diversi
Se qualcuno è interessato ad aiutare, posso anche fornire il codice, ma per fare domande semplici non l'ho fatto. Qualsiasi aiuto o suggerimento è più che benvenuto. Grazie.
EDIT:
Ecco Sub Main: (il suo scopo è quello di prendere dalle informazioni cartella di lavoro su quante prime file da copiare, perché ho bisogno di una volta di copiare prima 100, poi 50, poi 20, poi 10 ...)
Sub final()
Dim i As Integer
Dim x As Integer
For i = 7 To 11
x = ThisWorkbook.Worksheets(1).Range("N" & i).Value
Maximum_sub x
Minimum_sub x
Above_Average_sub x
Below_Average_sub x
Next i
End Sub
E qui è uno di questi subs: (Altri sono sostanzialmente le stesse, appena sorta criteri di modifiche)
Sub Maximum_sub(n As Integer)
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long
Dim srt As Sort
' The path\folder location of your files.
MyPath = "C:\Excel\"
' If there are no adequate files in the folder, exit.
FilesInPath = Dir(MyPath & "*.txt")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
' Fill the myFiles array with the list of adequate files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
'get a number: take a top __ from each
'n = ActiveWorkbook.Worksheets(1).Range("B4").Value
' Add a new workbook with one sheet.
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 1
' Loop through all files in the myFiles array.
If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
' Change this to fit your own needs.
' Sorting
Set srt = mybook.Worksheets(1).Sort
With srt
.SortFields.Clear
.SortFields.Add Key:=Columns("C"), SortOn:=xlSortOnValues, Order:=xlDescending
.SetRange Range("A1:C18000")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Deleting nulls
Do While (mybook.Worksheets(1).Range("C2").Value = "null")
mybook.Worksheets(1).Rows(2).Delete
Loop
Set sourceRange = mybook.Worksheets(1).Rows("2:" & n + 1)
SourceRcount = sourceRange.Rows.Count
Set destrange = BaseWks.Range("A" & rnum)
BaseWks.Cells(rnum, "A").Font.Bold = True
BaseWks.Cells(rnum, "B").Font.Bold = True
BaseWks.Cells(rnum, "C").Font.Bold = True
Set destrange = destrange.Resize(sourceRange.Rows.Count, sourceRange.Columns.Count)
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next FNum
BaseWks.Columns.AutoFit
End If
BaseWks.SaveAs Filename:="maximum_" & CStr(n)
Activewoorkbook.Close
End Sub
Vedendo il codice in questione sarebbe estremamente utile. Forse qualcosa non viene adeguatamente chiuso o eliminato. E indicare quale riga di codice sta causando l'errore. – LittleBobbyTables
è piuttosto lungo, ma cercherò di fornirlo in modifica nella domanda – balboa
@LittleBobbyTables ho fornito il codice. Grazie per lo sforzo. :) – balboa