Ich habe einige Subroutinen gemacht und sie arbeiteten in der Testphase auf 5 Dateien groß, aber wenn ich sie setzte auf reale Daten zu arbeiten, dh 600 Dateien nach einiger Zeit erhalte ich diese Meldung:Speichermangel Excel VBA
Excel kann diese Aufgabe nicht mit verfügbaren Ressourcen abschließen. Wählen Sie weniger Daten oder schließen Sie andere Anwendungen.
Ich habe es gegoogelt und das war ich gefunden application.cutcopymode = false
, aber in meinem Code, den ich nicht Ausschneiden und Kopieren-Modus, aber Griff mit
destrange.Value = sourceRange.Value
Kopieren Und wenn ich zu debuggen gehen , Ich meine nach einer Fehleraufforderung, es bringt mich zu dieser gleichen Codezeile. Wenn jemand auf eine ähnliche Situation gestoßen ist und weiß, wie er das Problem lösen kann, wäre ich dankbar.
Nur um mich klar zu machen habe ich versucht application.cutcopymode = false
und es hat nicht geholfen. Ich öffne jede dieser 600 Dateien, sortiere nach verschiedenen Kriterien und von jeder Kopie zuerst 100 in eine neue Arbeitsmappe (eine nach der anderen) und wenn ich mit einem Kriterium fertig bin, speichere und schließe ich diese neue Arbeitsmappe und öffne neue und fahre fort, Daten zu extrahieren verschiedene Kriterien.
Wenn jemand interessiert ist zu helfen, kann ich auch Code zur Verfügung stellen, aber um die Frage einfach zu machen, habe ich nicht. Jede Hilfe oder Anregung ist mehr als willkommen. Vielen Dank.
EDIT:
Hier ist Hauptunter: (es ist Zweck ist aus Arbeitsmappe Informationen zu übernehmen, wie viele ersten Zeilen zu kopieren, weil ich einmal muß zunächst 100 kopieren, dann 50, dann 20, dann 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
Und hier ist eine dieser U-Boote: (Others im Grunde die gleichen, nur Sortierkriterien Änderungen sind)
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
den entsprechenden Code sehen wäre äußerst hilfreich sein. Vielleicht wird etwas nicht richtig geschlossen oder entsorgt. Und zeigen Sie, welche Codezeile den Fehler verursacht. – LittleBobbyTables
es ist ziemlich lang, aber ich werde versuchen, es in Bearbeitung in Frage zu stellen – balboa
@LittleBobbyTables Ich habe Code zur Verfügung gestellt. Danke für die Mühe. :) – balboa