Textdatei einlesen mit Zeilen- und Spaltenauswahl
17.06.2013 09:02:13
Erich
Hi André, (oder gehört der Apostroph nicht über das "e"?)
die folgende Prozedur produziert wohl das Gewünschte - mit einer Abweichung:
In deiner Beispielmappe stehen in den ersten 8 Spalten Zahlen und Texte innerhalb einer Spalte munter durcheinander.
Das führt später leicht zu Verdruss.
Wenn du die Misch-Spalten vor dem Einfügen der Werte als "Text" (@) formatierst, werden das alles Texte.
Probier mal:
Option Explicit
Sub TextAusFileSpezial()
Dim strText As String, arZeil, arWmit, arUeb(), arWoEnd() As Long
Dim zq As Long, cq As Long, cz As Long, zz As Long, iw As Long
Dim myWert, dDat As Date, arWerte()
strText = TxtAusFile("F:\exc\www\tmp\Andre85849T.txt") ' Textfile
strText = TxtAusFile("F:\exc\www\tmp\Andre85856.txt") ' Textfile
arZeil = Split(strText, vbCrLf) ' Zeilen
arWmit = Split(arZeil(0), ";") ' Kopfzeilen-Werte
ReDim arUeb(1 To UBound(arWmit) + 1)
ReDim arWoEnd(1 To UBound(arWmit) + 1)
For cq = 0 To UBound(arWmit)
If arWmit(cq) "" Then
If cq 1 Then ' nicht Wochenende
cz = cz + 1
arUeb(cz) = dDat
Else ' Wochenend-Spalte merken
iw = iw + 1
arWoEnd(iw) = cq
End If
End If
End If
Next cq
Worksheets.Add Before:=Sheets(1)
Union(Columns("A:D"), Columns("F:H")).NumberFormat = "@" ' Text oder Standard ?
ReDim Preserve arUeb(1 To cz)
Cells(1, 1).Resize(, cz) = arUeb
ReDim arWerte(1 To UBound(arZeil), 1 To cz)
For zq = 1 To UBound(arZeil)
If arZeil(zq) "" Then
arWmit = Split(arZeil(zq), ";") ' Zeilen-Werte
If arWmit(5) """11 - Total""" And arWmit(5) """1SK""" Then
zz = zz + 1
iw = 1
cz = 0
For cq = 0 To UBound(arWmit)
If cq = arWoEnd(iw) Then
iw = iw + 1
Else
If arWmit(cq) "" Then
cz = cz + 1
arWerte(zz, cz) = Split(arWmit(cq), """")(1)
End If
End If
Next cq
End If
End If
Next zq
Cells(2, 1).Resize(zz, cz) = arWerte
End Sub
Function TxtAusFile(strFile As String) As String
Dim kan As Long
On Error Resume Next
If FileLen(strFile) = 0 Then Exit Function
On Error GoTo 0
kan = FreeFile
Open strFile For Binary As #kan
TxtAusFile = Space$(LOF(kan))
Get #kan, , TxtAusFile
Close #kan
End Function
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich