Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1412to1416
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA weniger Arbeitsspeicher nutzen möglich?

VBA weniger Arbeitsspeicher nutzen möglich?
10.03.2015 08:09:05
Jonas
Hallo zusammen!
Ich habe kein akutes Problem, aber interessieren würde es mich trotzdem.
Ich habe ein für meine Verhältnisse schönes und auch wunderbar funktionierendes Makro geschrieben welches mir bei Versuchsauswertungen hilft.
Leider habe ich es am Laptop dann nicht ausführen können da nur 4GB Arbeitsspeicher. Am Desktop PC ging es dann allerdings mit 11,8GB Arbeitsspeicherauslastung...
Ich habe bereits versucht den Zwischenspeicher am Ende jeder Schleife zu leeren, aber die Arbeisspeicherauslastung ist dadurch nicht runter gegangen.
Gibt es da eine Möglichkeit den genutzten Arbeitsspeicher gering zu halten?
Danke schonmal.
Grüße
Jonas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA weniger Arbeitsspeicher nutzen möglich?
10.03.2015 08:28:35
Nepumuk
Hallo,
VBA kann maximal 512 MB Arbeitsspeicher nutzen, wenn du mehr benötigst dann ist das wahrscheinlich das Clipboard. Aber ohne den Code zu sehen kann ich keine konkreten Angaben machen.
Gruß
Nepumuk

AW: VBA weniger Arbeitsspeicher nutzen möglich?
10.03.2015 15:12:55
Jonas
Hi!
Das dachte ich mir schon. Der Code ist ziemlich lang.
Ich versuche ihn mal etwas verkürzt ohne inhaltliche Änderungen darzustellen..
Sub Test_Makro_Anfang()
Dim i As Integer, z As Integer, b As Integer, f As Integer, r As Integer, y As Integer
For z = 1 To 15
Windows("A2-" & z & "P.xlsm").Activate
For i = 1 To Sheets.Count
Sheets(i).Select
Cells.Select
Range("I1").Activate
Selection.EntireRow.Hidden = False
Selection.EntireColumn.Hidden = False
Columns("M:M").Select
Selection.ClearContents
Dim lngZahl As Long
With ActiveSheet
If .ChartObjects.Count  0 Then
For lngZahl = .ChartObjects.Count To 1 Step -1
.ChartObjects(lngZahl).Delete
Next lngZahl
End If
End With
Windows("Ausgangsdatei.xlsm").Activate
Sheets("Ausgangsblatt").Select
Columns("B:B").Select
Selection.Copy
Windows("A2-" & z & "P.xlsm").Activate
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Windows("Ausgangsdatei.xlsm").Activate
Columns("O:Y").Select
Application.CutCopyMode = False
Selection.Copy
Windows("A2-" & z & "P.xlsm").Activate
Columns("O:O").Select
ActiveSheet.Paste
Columns("O:Y").EntireColumn.AutoFit
Windows("Ausgangsdatei.xlsm").Activate
Sheets("Ausgangsblatt").Select
ActiveSheet.ChartObjects("Diagramm 7").Select
ActiveChart.ChartArea.Copy
Windows("A2-" & z & "P.xlsm").Activate
Range("U4").Select
ActiveSheet.Paste
ActiveSheet.ChartObjects(1).Activate
ActiveChart.PlotArea.Select
ActiveChart.SeriesCollection(1).XValues = "='" & ActiveSheet.Name & "'!$B$3:$B$1503"
ActiveChart.SeriesCollection(1).Values = "='" & ActiveSheet.Name & "'!$D:$D"
ActiveChart.SeriesCollection(2).XValues = "='" & ActiveSheet.Name & "'!$B$3:$B$1503"
ActiveChart.SeriesCollection(2).Values = "='" & ActiveSheet.Name & "'!$O:$O"
ActiveChart.SeriesCollection(3).XValues = "='" & ActiveSheet.Name & "'!$B$3:$B$1503"
ActiveChart.SeriesCollection(3).Values = "='" & ActiveSheet.Name & "'!$P:$P"
ActiveChart.SeriesCollection(4).XValues = "='" & ActiveSheet.Name & "'!$R$4:$R$153"
ActiveChart.SeriesCollection(4).Values = "='" & ActiveSheet.Name & "'!$S:$S"
ActiveChart.SeriesCollection(5).XValues = "='" & ActiveSheet.Name & "'!$B$3:$B$1503"
ActiveChart.SeriesCollection(5).Values = "='" & ActiveSheet.Name & "'!$V:$V"
ActiveChart.SeriesCollection(6).XValues = "='" & ActiveSheet.Name & "'!$R$4:$R$153"
ActiveChart.SeriesCollection(6).Values = "='" & ActiveSheet.Name & "'!$X:$X"
ClearClipboard = True
Application.CutCopyMode = False
Next i
b = Sheets.Count
r = b + 1
Sheets.Add After:=ActiveSheet
Sheets(r).Select
Sheets(r).Name = "Fnetto"
Windows("Ausgangsdatei.xlsm").Activate
Sheets("fnetto").Select
ActiveSheet.ChartObjects("Diagramm 1").Copy
Windows("A2-" & z & "P.xlsm").Activate
Sheets("Fnetto").Select
ActiveSheet.Paste
For f = 1 To b
ActiveChart.SeriesCollection(f).XValues = "='" & Sheets(f).Name & "'!$B$3:$B$1503"
ActiveChart.SeriesCollection(f).Values = "='" & Sheets(f).Name & "'!$D:$D"
ActiveChart.SeriesCollection(f).Name = Sheets(f).Name
Next f
'Hier habe ich die Blätter r=b+2 bis b+6 ausgeblendet
r = b + 7
Sheets.Add After:=ActiveSheet
Sheets(r).Select
Sheets(r).Name = "Dehnviskosität über Weg"
Windows("Ausgangsdatei.xlsm").Activate
Sheets("fnetto").Select
ActiveSheet.ChartObjects("Diagramm 1").Copy
Windows("A2-" & z & "P.xlsm").Activate
Sheets("Dehnviskosität über Weg").Select
ActiveSheet.Paste
For f = 1 To b
ActiveChart.SeriesCollection(f).XValues = "='" & Sheets(f).Name & "'!$R$4:$R$153"
ActiveChart.SeriesCollection(f).Values = "='" & Sheets(f).Name & "'!$X:$X"
ActiveChart.SeriesCollection(f).Name = Sheets(f).Name
ActiveChart.ChartTitle.Text = "Dehnviskosität über Weg"
Next f
Next
End Sub

Anzeige
AW: VBA weniger Arbeitsspeicher nutzen möglich?
13.03.2015 18:52:03
fcs
Hallo Jonas,
das Problem könnten die Einstellungen/Optionen für die Zwischenablage sein.
1. die Option "Sammeln ohne Anzeige der Office-Zwischenablage" muss deaktiviert werden
2. das Zwischenablage-Fenster muss während der Makroausführung ausgeblendet sein.
Den 2. Punkt kann man noch per Makro steuern. Siehe unten.
Ansonsten wimmelt es in deinem Makro von Activate- und Select-Anweisungen mit Umschaltungen zwischen Arbeitsmappen und Tabellenblättern. Das alles schlägt schwer durch auf die Datenverwaltung von Excel. Ich hab mal versucht dein Makro in der Richtung zu bereinigen, indem entsprechende Objekt-Variablen verwendet werden, aber kann keine Garantie für Funktion geben - das kann man nur am leben Objekt durchtesten.
Die Gleichzeitige Verwaltung von mehr als 15 gleichzeitig geöffneten Dateien mit scheinbar jeweils mehr als 1500 Datenzeilen kann schwer auf den Arbeitsspeicher und die größe der Auslagerungsdatei durchschlagen.
Du solltest auch mal die UsedRange in den Tabellen prüfen, ob diese wesentlich größer ist als der eigentlich mit Daten ausgefüllte Zellbereich. Wenn ja, dann solltest du deine Tabellen mal aufräumen und und nicht benötigte Zellbereiche rechts und unterhalb der eigentlichen Daten mal komplett löschen.
Guß
Fanz
'Damit das Clipboard die Makro-Kopieraktionen nicht übernimmt muss die Option _
"Sammeln ohne Anzeige der Office-Zwischenablage" deaktiviert werden.
Sub Test_Makro1()
'Variablen-Deklarationen
Dim StatusClipboard As Boolean 'Merker für Status
'weiter Deklarationen
'Clipboard-Fenster in Excel ggf. ausblenden
StatusClipboard = Application.CommandBars("Office Clipboard").Visible
If StatusClipboard = True Then
Application.CommandBars("Office Clipboard").Visible = False
End If
'Code ....
'Clipboard-Fenster in Excel ggf. wieder einblenden
If StatusClipboard  Application.CommandBars("Office Clipboard").Visible Then
Application.CommandBars("Office Clipboard").Visible = StatusClipboard
End If
End Sub

Sub Test_Makro_Anfang()
Dim i As Integer, z As Integer, b As Integer, f As Integer, r As Integer, y As Integer
Dim wkb_A2_z_P As Workbook
Dim wks_A2_z_P As Worksheet, wks_A2_z_P_Ziel As Worksheet
Dim wkbAusgang As Workbook, wksAusgang As Worksheet, wksAusgang_Quelle As Worksheet
Dim StatusClipboard As Boolean, StatusCalc As Long
Dim lngZahl As Long
Set wkbAusgang = Windows("Ausgangsdatei.xlsm")
Set wksAusgang = wkbAusgang.Sheets("Ausgangsblatt")
'Makrobremsen lösen
With Application
StatusClipboard = .CommandBars("Office Clipboard").Visible
If StatusClipboard = True Then
.CommandBars("Office Clipboard").Visible = False
End If
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
End With
For z = 1 To 15
Set wkb_A2_z_P = Application.Workbooks("A2-" & z & "P.xlsm")
'        wkb_A2_z_P.Activate '?
For i = 1 To wkb_A2_z_P.Sheets.Count
Set wks_A2_z_P = wkb_A2_z_P.Sheets(i)
'          wks_A2_z_P.Select '?
'Cells.Select  ' NICHT NOTWENDIG
'          wks_A2_z_P.Range("I1").Activate '?
With wks_A2_z_P
.Rows.Hidden = False
.Columns.Hidden = False
.Columns("M:M").ClearContents
If .ChartObjects.Count  0 Then
For lngZahl = .ChartObjects.Count To 1 Step -1
.ChartObjects(lngZahl).Delete
Next lngZahl
End If
End With
'            wkbAusgang.Activate '?
'            wkbAusgang.Sheets("Ausgangsblatt").Select '?
wksAusgang.Range("B:B").EntireColumn.Copy  'Spalte B:B
'            wkb_A2_z_P.Activate '?
wks_A2_z_P.Columns(2).Insert Shift:=xlToRight
Application.CutCopyMode = False
'            wkbAusgang.Activate '?
wksAusgang.Range("O:Y").EntireColumn.Copy Destination:=wks_A2_z_P.Columns("O1")
'            wkb_A2_z_P.Activate '?
Application.CutCopyMode = False
wks_A2_z_P.Range("O:Y").EntireColumn.AutoFit
'            wkbAusgang.Activate '?
'            wksAusgang.Select '?
wksAusgang.ChartObjects("Diagramm 7").Chart.ChartArea.Copy
'            wkb_A2_z_P.Activate '?
wks_A2_z_P.Paste
Application.CutCopyMode = False
With wks_A2_z_P.Shapes(wks_A2_z_P.ChartObjects(1).Name)
.Top = wks_A2_z_P.Range("U4").Top
.Left = wks_A2_z_P.Range("U4").Left
End With
With wks_A2_z_P.ChartObjects(1).Chart
'ActiveChart.PlotArea.Select '-überflüssig
.SeriesCollection(1).XValues = "='" & wks_A2_z_P.Name & "'!$B$3:$B$1503"
.SeriesCollection(1).Values = "='" & wks_A2_z_P.Name & "'!$D:$D"
.SeriesCollection(2).XValues = "='" & wks_A2_z_P.Name & "'!$B$3:$B$1503"
.SeriesCollection(2).Values = "='" & wks_A2_z_P.Name & "'!$O:$O"
.SeriesCollection(3).XValues = "='" & wks_A2_z_P.Name & "'!$B$3:$B$1503"
.SeriesCollection(3).Values = "='" & wks_A2_z_P.Name & "'!$P:$P"
.SeriesCollection(4).XValues = "='" & wks_A2_z_P.Name & "'!$R$4:$R$153"
.SeriesCollection(4).Values = "='" & wks_A2_z_P.Name & "'!$S:$S"
.SeriesCollection(5).XValues = "='" & wks_A2_z_P.Name & "'!$B$3:$B$1503"
.SeriesCollection(5).Values = "='" & wks_A2_z_P.Name & "'!$V:$V"
.SeriesCollection(6).XValues = "='" & wks_A2_z_P.Name & "'!$R$4:$R$153"
.SeriesCollection(6).Values = "='" & wks_A2_z_P.Name & "'!$X:$X"
End With
' ?ClearClipboard = True ?  'da kommt bei mir eine Fehlermeldung
Application.CutCopyMode = False
Next i
b = wkb_A2_z_P.Sheets.Count
r = b + 1
With wkb_A2_z_P
.Sheets.Add After:=.Sheets(.Sheets.Count)
Set wks_A2_z_P_Ziel = .Sheets(.Sheets.Count)
End With
'      wks_A2_z_P_Ziel.Select '?
wks_A2_z_P_Ziel.Name = "Fnetto"
'      wkbAusgang.Activate '?
Set wksAusgang_Quelle = wkbAusgang.Sheets("fnetto")
'      wksAusgang_Quelle.Select '?
wksAusgang_Quelle.ChartObjects("Diagramm 1").Copy
'      wkb_A2_z_P.Activate '?
'      wks_A2_z_P_Ziel.Select '?
wks_A2_z_P_Ziel.Paste
Application.CutCopyMode = False
For f = 1 To b
With wks_A2_z_P_Ziel.ChartObjects(1).Chart
With .SeriesCollection(f)
.XValues = "='" & wkb_A2_z_P.Sheets(f).Name & "'!$B$3:$B$1503"
.Values = "='" & wkb_A2_z_P.Sheets(f).Name & "'!$D:$D"
.Name = wkb_A2_z_P.Sheets(f).Name
End With
End With
Next f
'Hier habe ich die Blätter r=b+2 bis b+6 ausgeblendet
r = b + 7
With wkb_A2_z_P
.Sheets.Add After:=.Sheets(.Sheets.Count)
Set wks_A2_z_P_Ziel = .Sheets(.Sheets.Count)
End With
'      wks_A2_z_P_Ziel.Select  '?
wks_A2_z_P_Ziel = "Dehnviskosität über Weg"
'      wkbAusgang.Activate '?
Set wksAusgang_Quelle = wkbAusgang.Sheets("fnetto")
'      wksAusgang_Quelle.Select '?
wksAusgang_Quelle.ChartObjects("Diagramm 1").Copy
'      wkb_A2_z_P.Activate  '?
'      wks_A2_z_P_Ziel.Select '?
wks_A2_z_P_Ziel.Paste
Application.CutCopyMode = False
For f = 1 To b
With wks_A2_z_P_Ziel.ChartObjects(1).Chart
With .SeriesCollection(f)
.XValues = "='" & Sheets(f).Name & "'!$R$4:$R$153"
.Values = "='" & Sheets(f).Name & "'!$X:$X"
.Name = Sheets(f).Name
End With
.ChartTitle.Text = "Dehnviskosität über Weg"
End With
Next f
Next z
'Makrobremsen zurücksetzen
With Application
If StatusClipboard  .CommandBars("Office Clipboard").Visible Then
.CommandBars("Office Clipboard").Visible = StatusClipboard
End If
.ScreenUpdating = True
.Calculation = StatusCalc
.EnableEvents = True
End With
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige