Anzeige
Archiv - Navigation
232to236
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
232to236
232to236
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Verarbeiten grosser Datenmengen

Verarbeiten grosser Datenmengen
24.03.2003 18:57:53
Jürgen
Hallo Excel User

Ich bearbeite mit VBA Programmen ungefähr 100 Arbeitsmappen ab.

Bei kleinen Datenmengen, das heisst weniger als 1000 Zeilen und 20 Spalten läuft alles prima.

Bei grösseren Datenmengen, das heisst mehr als 25000 Zeilen und 20 Spalten steigt der Rechner nach der 2. Mappe aus.

Ich nehme an Speicherprobleme.

Gibt es in VBA die Möglichkeit nicht mehr benutzten Speicher freizugeben. Oder welche andere Möglichkeit bsteht.

Gruss Jürgen

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Re: Verarbeiten grosser Datenmengen
24.03.2003 19:08:51
Forum

Hallo Jürgen

Du magst es nicht glauben, aber bei Fragen zum Code ist es immer besser wenn auch der Code gepostet wird. Ansonsten wird es nur eine Ratestunde.

Gruß

Re: Hier der Code
25.03.2003 10:00:57
Jürgen

Hallo Forum

Wie gewünscht hier der VBA Code.

Gruss und Herzlichen Dank im Voraus

Jürgen

Sub Auswerten_Tabellenblätter()
Dim arrFiles As Variant
Dim intcounter As Integer, intRow As Integer
Dim strpath As String
Dim wkb As Workbook
Dim wkb_name As String
Dim wks_Original As Worksheet
Dim wks_Kopie As Worksheet
Dim wks_Auswertung As Worksheet
Dim loaded As Boolean
strpath = GetDirectory("Bitte Ordner der Quelldateien auswählen:")
If strpath = "" Then Exit Sub
'Ermitteln der vorhandenen EXCEL Arbeitsmappen '
ChDir strpath
arrFiles = FileArray(strpath, "*.xls", "a")
intRow = 1
For intcounter = 1 To UBound(arrFiles)
Workbooks.Open strpath & arrFiles(intcounter)
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Kopie").Delete
Worksheets("Auswertung").Delete
Application.DisplayAlerts = True
Set wks_Original = ActiveWorkbook.Sheets(1)
With ActiveWorkbook
.Worksheets(1).Copy after:=.Worksheets(.Worksheets.Count)
End With
ActiveSheet.Name = ("Kopie")
Set wks_Kopie = ActiveWorkbook.Sheets(2)
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ("Auswertung")
Set wks_Auswertung = ActiveWorkbook.Sheets(3)
wks_Kopie.Activate
Call Filtern_Identnummer_Häufigkeit
ActiveWorkbook.Close savechanges:=True
'ActiveWorkbook.SaveAs strpath & arrFiles(intcounter)
'ActiveWorkbook.Close
Next intcounter
End Sub

Sub Filtern_Identnummer_Häufigkeit()
'Tabelle nacheinander nach verschiedenen Kriterien filtern und das jeweilige Ergebnis drucken lassen?
Dim arr()
Dim Text_Unterlagenart()
Dim iRow As Integer, icol As Integer
Dim AnzPostotal As Integer
Dim AnzPos As Integer
Dim letzte As Long
Dim Anzahl As Integer
Dim intcounter As Integer
'Anzahl belegter Zeilen in Datei
AnzPostotal = Cells(Rows.Count, 1).End(xlUp).Row
'Ausfiltern Zeilen Spalte A / jede Nummer kommt nur einmal vor
iRow = 1
icol = Cells(iRow, 256).End(xlToLeft).Column + 1
With ActiveSheet.Range("A:A")
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(iRow, icol), _
Unique:=True
End With
AnzPos = Cells(Rows.Count, icol).End(xlUp).Row
MsgBox AnzPos

'Ausfiltern Spalte E nach Kriterien
icol = Cells(2, 256).End(xlToLeft).Column + 1
With ActiveSheet.Range("E:E")
.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, icol), _
Unique:=True
End With
iRow = 1
Do Until IsEmpty(Cells(iRow, icol))
ReDim Preserve arr(iRow - 1)
iRow = iRow + 1
Loop
'Leerzeile für Autofilter einfügen
If Not IsEmpty(Cells(1, 1)) Then
With Rows("1:1")
.Insert Shift:=xlDown
End With
End If
For iRow = 1 To UBound(arr)
Columns("E").AutoFilter Field:=1, Criteria1:=arr(iRow)
letzte = ActiveSheet.Range("A:A").SpecialCells(xlCellTypeLastCell).Row
Anzahl = 0
For intcounter = letzte To 2 Step -1
If Rows(intcounter).RowHeight > 0 Then
Anzahl = Anzahl + 1
End If
Next intcounter
MsgBox Text_Unterlagenart(iRow) & Anzahl
Next iRow
Range("A1").AutoFilter
End Sub


Anzeige
Re: Hier der Code
25.03.2003 10:05:48
Forum

Hallo Jürgen

du magst es ja nicht glauben, Deine Frage war gestern im Forum.
Bei der automatischen Benachrichtigung wird nur die Letzte und vorletzte Nachricht angezeigt. Ich sehe jetzt Deinen Code, aber nicht mehr die Frage.

Gruß

Re: Hier die Frage
25.03.2003 10:48:29
Jürgen

Hallo Excel User
Ich bearbeite mit VBA Programmen ungefähr 100 Arbeitsmappen ab.

Bei kleinen Datenmengen, das heisst weniger als 1000 Zeilen und 20 Spalten läuft alles prima.

Bei grösseren Datenmengen, das heisst mehr als 25000 Zeilen und 20 Spalten steigt der Rechner nach der 2. Mappe aus.

Ich nehme an Arbeitsspeicherprobleme.

Gibt es in VBA die Möglichkeit nicht mehr benutzten Speicher freizugeben. Oder welche andere Möglichkeit bsteht.

Gruss Jürgen

Anzeige
Re: Hier die Frage
25.03.2003 10:55:30
Forum

Hallo Jürgen

lösche die Variablen die Du mit Set gesetzt hast

Set wks_Original =Nothing

Gruß

Re: Hat leider nicht geholfen
25.03.2003 11:18:19
Jürgen

Hallo Forum

Hat leider nicht geholfen.

Die erste Mappe wird sauber abgearbeitet, danach stürzt
Programm ab ( keine Rückmeldung )

Gruss Jürgen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige