AW: .txt Dateien auslesen, die Drölfste
11.10.2011 11:13:55
Tino
Hallo,
kannst mal testen.
Sub Lese_Txt()
Dim sFile$, F%, sInhalt$
Dim ArrayIn, ArrayAus(), n&, nn&
Dim sZeilenUmbruch
sZeilenUmbruch = Chr(8) & Chr(9) & Chr(10) & Chr(13)
sFile = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If sFile = CStr(False) Then Exit Sub
If Dir$(sFile, vbNormal) <> "" Then
F = FreeFile
Open sFile For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close
End If
If sInhalt <> "" Then
'Text Teilen bei "["
ArrayIn = Split(sInhalt, "[")
'Array Ausgabe groß genug Dimentionieren
Redim Preserve ArrayAus(1 To Ubound(ArrayIn), 1 To 1)
For n = 1 To Ubound(ArrayIn)
'prüfen ob Zeichen ] enthalten
If InStr(ArrayIn(n), "]") Then
nn = nn + 1
'Text entfernen bis ]
ArrayIn(n) = Trim$(Mid$(ArrayIn(n), InStr(ArrayIn(n), "]") + 1, Len(ArrayIn(n))))
': entfernen wenn am Anfang vorhanden
If Left$(ArrayIn(n), 1) = ":" Then ArrayIn(n) = Trim$(Mid$(ArrayIn(n), 2, Len(ArrayIn(n))))
'Zeilenumbrüche am Anfang und Ende löschen
Do While InStr(sZeilenUmbruch, Left$(ArrayIn(n), 1)) > 0
ArrayIn(n) = Trim$(Mid$(ArrayIn(n), 2, Len(ArrayIn(n))))
Loop
Do While InStr(sZeilenUmbruch, Right$(ArrayIn(n), 1)) > 0
ArrayIn(n) = Trim$(Mid$(ArrayIn(n), 1, Len(ArrayIn(n)) - 1))
Loop
'Text in Ausgabe- Array
ArrayAus(nn, 1) = ArrayIn(n)
'ist Text eine Zahl, umwandeln in eine Zahl
If IsNumeric(ArrayAus(nn, 1)) Then ArrayAus(nn, 1) = ArrayAus(nn, 1) * 1
End If
Next n
End If
If nn > 0 Then
'Ausgabe, evtl. Tabelle anpassen
With Sheets("Tabelle1")
'Spalte leer machen für neue Daten, evtl. löschen fals nicht benötigt
.Range("A2", .Cells(.Rows.Count, 1)).ClearContents
'Array ausgeben ab A2
.Range("A2").Resize(nn) = ArrayAus
End With
End If
End Sub
Gruß Tino