Frage zu einem Textimportmakro von Ramses?!?
16.10.2006 14:46:18
Ramses?!?
ich habe im Archiv ein Makro von @Ramses gefunden, welches Textdateien, die mehr als 65536 Zeilen enthält, einließt und auf mehrere Tabellenblätter aufteilt. Nachfolgend erst mal das Makro.
Option Explicit
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.
Line 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 = 0 To txtlines - 1
Line 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 = Worksheets.Count To 2 Step -1
Application.DisplayAlerts = False
Worksheets(i).Delete
Application.DisplayAlerts = True
Next
OldStatusbar = Application.DisplayStatusBar
'Namen vergeben
Worksheets(1).Name = "Dataset from 1"
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
'Aufsplitten der bisher eingelesenen Daten
'Indem die Trennung anhand von der Semikolons vorgenommen wird
Application.StatusBar = "Datentrennung wird vorgenommen"
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), Semicolon:=True
Range("A1").Select
dataFitting = False
tWkb.Worksheets.Add After:=ActiveSheet
ActiveSheet.Name = "Dataset from " & i
tWks = ActiveSheet.Name
n = 1
End If
'Richtes Wort
tWkb.Worksheets(tWks).Cells(n, 1) = textArr(i)
n = n + 1
Next i
Application.StatusBar = "Datentrennung wird vorgenommen"
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), Semicolon:=True
Range("A1").Select
MsgBox "BigDict.txt vollständig eingelesen"
Application.DisplayStatusBar = OldStatusbar
End Sub
Das Makro funktioniert hervorragend. Nur bräuchte ich es ein wenig abgeändert. Bei mir müsste das Makro vor dem Einfügen der Daten auf das nächste Tabellenblatt aus dem alten Blatt die letzten 111 Zeilen kopieren und in das neue Blatt einfügen und erst dann ab Zeile 112 wieder die Daten aus der Textdatei.
Als Beispiel: Ich habe in der Textdatei 196608 Zeilen. Dann würde das Makro von Ramses die Daten in 3 Tabellenblätter einlesen. Das wären die Blätter Dataset from 1, Dataset from 65536, Dataset from 131072. Nun müssten in Blatt Dataset from 65536 in den Zeilen 1 bis 111 die Daten aus Blatt Dataset from 1 von Zeile 65425 bis 65536 und in Blatt Dataset from 131072 Zeile 1 bis 111 die Daten aus Blatt Dataset from 65536 von Zeile 65425 bis 65536 stehen.
Ich hoffe, jemand hat verstanden um was es mir geht. Der Hintergrund, in der Textdatei stehen Personendaten. Für jede Person sind es 111 Zeilen. Das Problem ist halt, das am Blattende nicht auch die Person zu ende ist, sondern irgendwo mitten drinn. Ich müsste dann in einer nachfolgenden Prüfung, die ich schon hinbekomme, prüfen, wer ist der letzte Name in Blatt Dataset from 1. Diesen müsste ich dann in Blatt Dataset from 65536 suchen. Normalerweise steht der nicht in Blatt Dataset from 65536. Aber durch das Kopieren der letzten 111 Zeilen aus dem Blatt Dataset from 1, müsste der Name mit den Daten auch wieder in dem Blatt Dataset from 65536 auftauchen.
Man ist das kompliziert zu beschreiben. Aber ich hoffe, jemand hat das verstanden.
Danke für die Hilfe und Gruß,
Kasimir.