AW: Zahlen umsortieren
09.01.2007 16:04:07
Ramses
Hallo
den Code in ein Modul deiner Mappe kopieren und ausführen lassen
Sub Read_Big_File()
'Liest csv und txt Datein mit mehr als 65536 Datensätzen ein
'Der eingelesene Text wird in die aktuelle Tabelle
'beginnedn ab Spalte 1 geschrieben
'------------------------------
'Hilfsvariable für Anzahl Datensätze
Dim Text1 As String
'Variablen für den Array nötig
Dim txtLines As Long, i As Long, n As Long
'Neue Mappe und Variables Tabellenblatt deklarieren
Dim tWkb As Workbook, tWks As String
Dim tarRow As Integer, tarCol As Integer, maxLines
'Für Office97 muss das Array TextArr als String definiert werden
'Entdeckt duch Gerd Z aus dem Herber Forum
Dim TextArr As Variant
Dim ReadFile As String
Dim OldStatusbar
'*******************
'Standardanzahl Zeilen von EXCEL
'sind etwa 56 Zeilen pro Seite
'Bitte anpassen
maxLines = 56
'********************
'Hier nichts mehr ändern
'Dialog öffnen auf Basis von *.dat Files
ReadFile = Application.GetOpenFilename("CSV Files (*.csv;*.txt),")
'Schliessen einer geöffneten Datei
Close #1
'1. Öffnen der Datei
'Den Namen und Pfad bitte anpassen
Open ReadFile For Input As #1
'Die anzahl ist nötig um die Grösse des Arrays zu deklarieren
'Zähler auf 0 setzen
txtLines = 0
Do While Not EOF(1) ' Schleife bis Dateiende.
Input #1, Text1 ' Hilfsvariable zum einlesen verwenden
'Zähler hochzählen
txtLines = txtLines + 1
Loop
'Schliessen der Datei weil Dateiende erreicht wurde
Close #1
'Erneutes Öffnen um zum Dateianfang zu kommen
Open ReadFile For Input As #1 ' Datei zum Einlesen öffnen.
'Array neu auf die Anzahl der Linien initialisieren
ReDim TextArr(txtLines)
'Einlesen der Dateien in das Array
For i = 1 To txtLines
Input #1, TextArr(i)
Next i
Close #1
OldStatusbar = Application.DisplayStatusBar
'Namen vergeben
Worksheets(1).Name = "Data1"
tWks = tWkb.Worksheets(1).Name
'Daten in aktuelles Sheet schreiben
n = 1
tarRow = 1
tarCol = 1
Application.ScreenUpdating = False
For i = 1 To txtLines
Application.StatusBar = "Datensatz " & i & " von " & txtLines & " wird eingelesen"
'Neue Tabelle anlegen wenn Zelle 65536 erreicht wurde
If i Mod maxLines = 0 Then
Cells(tarRow, tarCol) = TextArr(i)
tarRow = 1
tarCol = tarCol + 1
Else
Cells(tarRow, tarCol) = TextArr(i)
tarRow = tarRow + 1
End If
Next i
Application.ScreenUpdating = True
MsgBox ReadFile & " mit " & txtLines & " Datensätzen vollständig eingelesen"
Application.DisplayStatusBar = OldStatusbar
End Sub
Gruss Rainer