txt-Datei importieren

Hallo,
Ich möchte Daten aus einer txt-Datei in Excel kopieren und habe folgendes Makro gefunden:

Sub Datei_importieren()
Dim Datei As String, Text As String
Dim Zeile As Long
On Error GoTo Fehler
'Quelldatei festlegen
Datei = ThisWorkbook.Path & "\test.txt"
Open Datei For Input As #1         ' Quelldatei öffnen.
Zeile = 1
Do While Not EOF(1)           ' Schleife bis Dateiende
Line Input #1, Text      ' Text lesen
ActiveSheet.Cells(Zeile, 1) = Text
Zeile = Zeile + 1
Loop
Close #1   'Quelldatei schließen
Exit Sub
Fehler:
Close #1
MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _
& "Beschreibung: " & Err.Description _
, vbCritical, "da ist leider ein Fehler aufgetreten"
End Sub

Rohdaten alles ohne Absatz:

;per Fax,141285,,LIE15/139852,LIE15/139852;per Fax,303194,,LIE15/139853,LIE15/139853

Nun werden die Daten aber alle in einer Zelle gespeichert und nicht wie folgt:

per Fax	141285		LIE15/139852	LIE15/139852
per Fax	303194		LIE15/139853	LIE15/139853

Außerdem möchte ich, dass nach jedem Semikolon eine neue Zeile angefangen wird. Gibt es hierfür eine Lösung?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Datei_importieren() Dim Datei As String, sText As String, vDaten, vTmp, i As Long, j As Long Dim Zeile As Long On Error GoTo Fehler 'Quelldatei festlegen Datei = ThisWorkbook.Path & "\test.txt" Zeile = 1 Open Datei For Input As #1 ' Quelldatei öffnen. Do While Not EOF(1) ' Schleife bis Dateiende Line Input #1, sText ' Text lesen vDaten = vDaten & vbCrLf & sText Loop Close #1 'Quelldatei schließen vDaten = Mid(vDaten, 2) vDaten = Split(vDaten, vbCrLf) For i = 0 To UBound(vDaten) vTmp = Split(vDaten(i), ";") For j = 0 To UBound(vTmp) Cells(Zeile, 1).Resize(, UBound(Split(vTmp(j), ",")) + 1) = Split(vTmp(j), ",") Zeile = Zeile + 1 Next j Next i Exit Sub Fehler: Close #1 MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _ & "Beschreibung: " & Err.Description _ , vbCritical, "da ist leider ein Fehler aufgetreten" End Sub

Sub Datei_importieren() Dim Datei As String, sText As String, vDaten, vTmp, i As Long, j As Long Dim Zeile As Long Dim wksNeu As Worksheet On Error GoTo Fehler Set wksNeu = Workbooks.Add.Sheets(1) 'Quelldatei festlegen Datei = ThisWorkbook.Path & "\test.txt" Zeile = 1 Open Datei For Input As #1 ' Quelldatei öffnen. Do While Not EOF(1) ' Schleife bis Dateiende Line Input #1, sText ' Text lesen vDaten = vDaten & vbCrLf & sText Loop Close #1 'Quelldatei schließen vDaten = Mid(vDaten, 2) vDaten = Split(vDaten, vbCrLf) For i = 0 To UBound(vDaten) vTmp = Split(vDaten(i), ";") For j = 0 To UBound(vTmp) wksNeu.Cells(Zeile, 1).Resize(, UBound(Split(vTmp(j), ",")) + 1) = Split(vTmp(j), ",") Zeile = Zeile + 1 Next j Next i With wksNeu.Parent .SaveAs Filename:=Left(Datei, Len(Datei) - 4), _ FileFormat:=xlOpenXMLWorkbook ' oder xlExcel8 '.Close End With Exit Sub Fehler: Close #1 MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _ & "Beschreibung: " & Err.Description _ , vbCritical, "da ist leider ein Fehler aufgetreten" End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread