AW: Filterinhalt speichen unter in
23.03.2014 00:22:10
joe
Hallo Thorsten,
vielen Dank für Deine Rückmeldung.
Ich habe inzwischen über einen Filter die Zeilen in ein neues Tabellenblatt kopiert, gespeichert und dann gelöscht und den Filter erneut gesetzt und wiederhole dies, bis das Tabellenblatt mit 900.000 Zeilen leer ist.
Mir klingeln die Ohren, wenn das gelesen wird, das ist sicher nicht schön und schon gar nicht perfomant. Ich habe aber nun "VBA-Blut" geleckt und will dran bleiben.
Wenn Du Zeit und Lust hast, schau doch mal über das coding. Müsste ich das nicht über ein array lösen, dann könnte die Wiederholung der Schritte im array erfolgen?
Vielen Dank für Deine Mühe,
Gruß, Joe.
+++++
https://www.herber.de/bbs/user/89805.xlsx
++++
Sub Files_erzeugen()
Range("A2").Select
ActiveSheet.Range("$A$1:$H$3800").AutoFilter Field:=1, Criteria1:=ActiveCell.Value
' der geringe wert soll helfen ,die rechenoperation für das filtern zu verkürzen, zuvor _
sind die zeilensortiert.
Range("A2").Select
ActiveSheet.Range("A2:H" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Copy
' neue Datei erzeugen:
Workbooks.Add
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.FormulaR1C1 = "Data1"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Data2"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Data3"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Data3"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Data4"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Data5"
Range("G1").Select
ActiveCell.FormulaR1C1 = "Data6"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Data7"
Cells.Select
Cells.EntireColumn.AutoFit
Range("B2").Select
ActiveWindow.FreezePanes = True
Range("A2").Select
' Tabellenblatt und Tabelle 2 und 3 ohne Rückfrage löschen:
Application.DisplayAlerts = False
Sheets("Tabelle2").Delete
Sheets("Tabelle3").Delete
Application.DisplayAlerts = True
' und jezt das neue Workbbok schliessen
ActiveWorkbook.SaveAs Filename:="H:\zz\TEST\Data1_" & Cells(2, 1) & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
' wieder zurück zur alten Datei, den Autofilter entfernen, neu setzen....
ActiveSheet.Range("A2:H" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Selection.AutoFilter
Range("A2").Select
'so und jetzt lassen das ganze so lange laufen, bis der Prozessor heiss wird
'* Loop
Call START
End Sub
++++++