AW: Mehrere externe *.txt einlesen + sortieren
10.08.2006 17:30:25
fcs
Hallo Jens,
das war jetzt die leichtere Übung :)
Ich bin mal davon ausgegangen, das rechts vom "=" immer ganze Zahlen stehen und lasse den Text in eine Zahl konvertieren. Falls dem nicht so ist, dann in der entsprechenden Zeile die Val(...)-Funktion in der Anweisung wieder entfernen. Falls bei Dezimalzahlen "," statt "." verwendet wird, dann "Val" durch "CDbl" ersetzen.
Gruß
Franz
Hier der angepasstte Code:
Sub TextImport()
'Alle Daten auf ein Blatt
Dim wb As Workbook, wks As Worksheet, Zeile1 As Long, Zeile2 As Long, Dateien As Variant, Text As Variant
Dim I As Integer, Spalte As Integer, SpaltenUe As Integer
' Auswahldialog für Dateien anzeigen
Dateien = Application.GetOpenFilename(Filefilter:="Textfiles (*.txt),*.txt", _
Title:="Bitte einzulesende Text-Dateien auswählen, Mehrfachauswahl ist möglich", MultiSelect:=True)
On Error GoTo Fehler ' Fängt Fehler ab, wenn Abbrechen gewählt wurde
If UBound(Dateien) > 0 Then
' Neues Mappe erstellen mit 1. Blatt
Workbooks.Add Template:=xlWBATWorksheet
Set wks = ActiveSheet
SpaltenUe = 1 'Anzahl Spalten mit Überschriften-Titeln
ZeileUe = 1
wks.Cells(ZeileUe, SpaltenUe) = "Textdatei"
Zeile1 = ZeileUe + 1
Zeile2 = Zeile1
For I = 1 To UBound(Dateien)
'Daten einlesen
Open Dateien(I) For Input Access Read As #1
Do Until EOF(1)
Line Input #1, Text
If Left(Text, 1) = "[" Then 'Header
'Überschriften vergleichen und ggf. einfügen
For Spalte = 2 To SpaltenUe + 1
If IsEmpty(wks.Cells(ZeileUe, Spalte)) Then
wks.Cells(ZeileUe, Spalte) = Text
wks.Cells(ZeileUe, Spalte + 1) = Text & "_Wert"
SpaltenUe = SpaltenUe + 2
Exit For
Else
If wks.Cells(ZeileUe, Spalte) = Text Then Exit For
End If
Next
Zeile = Zeile1
Else
wks.Cells(Zeile, Spalte) = Trim(Mid(Text, 1, InStr(1, Text, "=") - 1))
wks.Cells(Zeile, Spalte + 1) = Val(Trim(Mid(Text, InStr(1, Text, "=") + 1, 100)))
If Zeile > Zeile2 Then Zeile2 = Zeile
Zeile = Zeile + 1
End If
Loop
Close #1
'Dateinamen in 1. Spalte Eintragen
For Zeile = Zeile1 To Zeile2
wks.Cells(Zeile, 1) = Dateien(I)
Next
Zeile1 = Zeile2 + 1
Zeile2 = Zeile1
Next
wks.Columns(1).AutoFit 'Spalte A auf optimale Breite einstellen
wks.Range("B2").Select
ActiveWindow.FreezePanes = True
End If
Fehler:
End Sub
Sub TextImport2()
'Daten jeder Text-Datei auf eigenes Blatt
Dim wks As Worksheet, Zeile1 As Long, Zeile2 As Long, Dateien As Variant, Text As Variant
Dim I As Integer, J As Integer, Spalte As Integer, Tabname As String
' Auswahldialog für Dateien anzeigen
Dateien = Application.GetOpenFilename(Filefilter:="Textfiles (*.txt),*.txt", _
Title:="Bitte einzulesende Text-Dateien auswählen, Mehrfachauswahl ist möglich", MultiSelect:=True)
On Error GoTo Fehler ' Fängt Fehler ab, wenn Abbrechen gewählt wurde
If UBound(Dateien) > 0 Then
' Neues Mappe erstellen mit 1. Blatt
Workbooks.Add Template:=xlWBATWorksheet
For I = 1 To UBound(Dateien)
Set wks = ActiveSheet
'Tabellenname = Name Textdatei ohne Pfad und Endung .txt
Tabname = ""
For J = Len(Dateien(I)) - 4 To 1 Step -1
If Mid(Dateien(I), J, 1) <> "\" Then
Tabname = Mid(Dateien(I), J, 1) & Tabname
Else
Exit For
End If
Next
Spalte = -1 'Anzahl Spalten mit Überschriften-Titeln
ZeileUe = 1
wks.Name = Tabname
Zeile1 = ZeileUe + 1
Zeile2 = Zeile1
'Daten einlesen
Open Dateien(I) For Input Access Read As #1
Do Until EOF(1)
Line Input #1, Text
If Left(Text, 1) = "[" Then 'Header
'Überschrifte einfügen
Spalte = Spalte + 2
wks.Cells(ZeileUe, Spalte) = Text
wks.Cells(ZeileUe, Spalte + 1) = Text & "_Wert"
Zeile = Zeile1 'Zeilenzähler setzen
Else
wks.Cells(Zeile, Spalte) = Trim(Mid(Text, 1, InStr(1, Text, "=") - 1))
wks.Cells(Zeile, Spalte + 1) = Val(Trim(Mid(Text, InStr(1, Text, "=") + 1, 100)))
If Zeile > Zeile2 Then Zeile2 = Zeile
Zeile = Zeile + 1
End If
Loop
Close #1
wks.Range("A2").Select
ActiveWindow.FreezePanes = True
Zeile1 = Zeile2 + 1
Zeile2 = Zeile1
If I < UBound(Dateien) Then
' Neues Blatt einfügen
Worksheets.Add After:=Sheets(Sheets.Count)
End If
Next
End If
Fehler:
End Sub