Herbers Excel-Forum - das Archiv

Sub Read_Bigdicttxt_File()
'Liest Text Datein mit mehr als 65536 Datensätzen ein
'und erstellt automatisch eine neu Arbetismappe und Worksheets
'Der eingelesene Text wird in Spalte 1 geschrieben
'der Reverse Text in spalte 2
'------------------------------
'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
'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
'Dialog öffnen auf Basis von *.dat Files
ReadFile = Application.GetOpenFilename("DAT Files (*.txt;*.dat),")
'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
'Arbeitsmappe erstellen und zuweisen
Workbooks.Add
Set tWkb = ActiveWorkbook
'Alles löschen bis auf eine Tabelle
'>> Kosmetik :-)
For i = 2 To Worksheets.Count
    Application.DisplayAlerts = False
    Worksheets(i).Delete
    Application.DisplayAlerts = True
Next
OldStatusbar = Application.DisplayStatusBar
'Namen vergeben
Worksheets(1).Name = "Data1"
tWks = tWkb.Worksheets(1).Name
'Daten in aktuelles Sheet schreiben
n = 1
For i = 1 To txtlines
    Application.StatusBar = "Datensatz " & i & " von " & txtlines & " wird eingelesen"
    'Neue Tabelle anlegen wenn Zelle 65536 erreicht wurde
    If i Mod 65536 = 0 Then
        tWkb.Worksheets.Add after:=ActiveSheet
        ActiveSheet.Name = "Data" & i
        tWks = ActiveSheet.Name
        n = 1
    End If
    'Richtes Wort
    tWkb.Worksheets(tWks).Cells(n, 1) = textArr(i)
    'Wort umgedreht
    tWkb.Worksheets(tWks).Cells(n, 2) = StrReverse(textArr(i))
    n = n + 1
Next i
MsgBox "BigDict.txt vollständig eingelesen"
Application.DisplayStatusBar = OldStatusbar
End Sub 

480'000 Zeilen in knapp 12 Sekunden ;-)

Gruss Rainer

Betrifft: AW: Textdateien möglichst schnell laden
von: Gunnar
Geschrieben am: 02.11.2003 21:26:09
Hey, cool, danke vielmals, werde ich gleich mal machen. Woher haste das denn so schnell her?

Viele Grüsse, Gunnar

Betrifft: AW: Textdateien möglichst schnell laden
von: K.Rola
Geschrieben am: 02.11.2003 21:32:33
Hallo, Ramses,

mit:
Workbooks.Add (1)
wird eine neue Mappe mit einem sheet erzeugt, dann kannst
du die Zeichen für die Kosmetik sparen :°)

Gruß K.Rola

Betrifft: Danke für die Info :-)) o.T.
von: Ramses
Geschrieben am: 02.11.2003 21:35:20
...

Bewerten Sie hier bitte das Excel-Portal

Excel-Beispiele zum Thema " Textdateien möglichst schnell laden"
400 leere Textdateien anlegen	Textdateien verbinden
Textdateien vergleichen und Unterschiede dokumentieren	Textdateien auslesen und in Werte in Zellen eintragen
Fragen aus Textdateien in UserForm-Label einlesen	Text in Textdateien suchen und Fundzeilen in Tabelle ausgeben
UserForm-TextBoxes-Texte in Textdateien speichern	Tabellenblattinhalte in getrennten Textdateien speichern
Bei Doppelklick Textdateien in Editor öffnen	Aufruf von Textdateien protokollieren