[b]Option Explicit
Sub Datei_einlesen()
Dim Text1 As String, firstRow As Integer
Dim txtlines As Long, i As Long, Zähler As Long
Dim WorkbookName As Workbook, ActiveSheetName As String
Rem: Für Office97 muss das Array TextArr als String definiert werden
Dim textArr As Variant, Verein As String
Dim dataFitting, ReadFile As String
Rem: Dialog öffnen auf Basis von *.dat Files
ReadFile = Application.GetOpenFilename("Alle Dateien (*.*),")
Rem: Wenn Abbruchtraste beatätigt wurde
On Error GoTo Weiter
If ReadFile = False Then Exit Sub
Weiter:
Application.ScreenUpdating = False
Rem: Leerblatt einfügen
Sheets.Add Before:=Sheets(1)
Sheets(1).Name = "Auswertung von Zeile 1"
Rem: Schliessen einer geöffneten Datei
Close #1
Rem: 1. Öffnen der Datei
Open ReadFile For Input As #1
Rem: Die Anzahl ist nötig um die Grösse des Arrays zu deklarieren
Rem: Zähler auf 0 setzen
txtlines = 0
Rem: Schleife bis Dateiende.
Do While Not EOF(1)
Rem: Hilfsvariable zum einlesen verwenden
Line Input #1, Text1
Rem: Zähler hochzählen
txtlines = txtlines + 1
Loop
Rem: Schliessen der Datei weil Dateiende erreicht wurde
Close #1
Rem: Erneutes Öffnen um zum Dateianfang zu kommen
Open ReadFile For Input As #1
Rem: Array neu auf die Anzahl der Linien initialisieren
ReDim textArr(txtlines)
Rem: Einlesen der Dateien in das Array
For i = 0 To txtlines - 1
Line Input #1, textArr(i)
Next i
Close #1
Rem: Namen vergeben
ActiveSheetName = Worksheets(1).Name
Rem: Daten in aktuelles Sheet schreiben
Zähler = 1
For i = 1 To txtlines
Application.StatusBar = "Datensatz " & i & " von " & txtlines & " wird eingelesen"
Rem: Neue Tabelle anlegen wenn Zelle 65536 erreicht wurde
If Zähler Mod 65536 = 0 Then
Rem: Aufsplitten der bisher eingelesenen Daten
Rem: Indem die Trennung anhand von der Semikolons vorgenommen wird
Application.StatusBar = "Datentrennung wird vorgenommen"
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Range("A1").Select
dataFitting = False
Worksheets.Add After:=ActiveSheet
ActiveSheet.Name = "Auswertung von Zeile " & i
ActiveSheetName = ActiveSheet.Name
Zähler = Sheets("Auswertung von Zeile " & i).Range("A65536").End(xlUp).Offset(1, 0).Row
End If
Worksheets(ActiveSheetName).Cells(Zähler, 1) = textArr(i)
Zähler = Zähler + 1
Next i
End Sub
[/b]
Transponieren kompleser Spalten
ikos 18.01.2007 - 114 Hits -
Tabelleninhalte einer excel-Tabelle kopieren und in eine neue Tabelle einfügen
Sternschnuppe 10.03.2007 - 482 Hits - 2 Antworten
Excel Tabelle NICHT im Browser sonder in Excel öffnen
JokaInThaHouse 12.04.2007 - 150 Hits - 2 Antworten
Outlook Termine in Excel
cox 13.09.2007 - 236 Hits - 2 Antworten
Wie sortiere ich eine excel Tabelle?
dergruss 19.12.2007 - 180 Hits - 1 Antwort