Textdatei importieren

Hallo!
Ich habe folgendes Excel-Problem. Ich möchte Textdateien in ein Excelblatt importieren. Da die Textdateien unterschiedliche Namen haben, soll am Anfang
die entsprechende Datei auswählbar sein. Die Textdatei soll zeilenweise
importiert werden. In der Textdatei sind die einzelnen Wörter durch Leerzeilen
getrennt. Es gibt in der Zeile keine fest vorgegebene Anzahl von Wörtern. Beim
Importieren soll das erste Wort der jeweiligen Zeile in die erste Spalte, das
2. Wort in die 2.Spalte importiert werden. Alle anderen vorkommenden Wörter
sollen, wieder durch Leerzeichen getrennt, in die 3. Spalte importiert werden.
Hat jemand eine Idde, wie man so etwas realisieren kann?
Danke im voraus
Rainer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub TextImport() 'Importiert den Inhalt einer Textdatei aus Wörtern mit Leerzeichen als Trennzeichen 'ins aktive Tabellenblatt Dim wks As Worksheet, strDatei As Variant, strText As String, iLeerzeichen As Integer Dim Zeile As Long, iPosBlank As Integer Set wks = ActiveSheet wks.Cells.ClearContents ' Daten in Tabelle löschen Zeile = 2 '1. Zeile in die Text eingetragen wird Do strDatei = Application.GetOpenFilename(Filefilter:="Textdateien,*.txt", Title:="Textdatei auswählen", MultiSelect:=False) If strDatei = False Then Exit Sub Open strDatei For Input As #1 With wks Do Until EOF(1) Input #1, strText 'Anzahl Leerzeichen in Zeile iLeerzeichen = 0 For I = 1 To Len(strText) If Mid(strText, I, 1) = " " Then iLeerzeichen = iLeerzeichen + 1 End If Next I 'Texte in Tabelle eintragen Select Case iLeerzeichen Case 0 .Cells(Zeile, 1).Value = strText Case 1 iPosBlank = InStr(1, strText, " ") .Cells(Zeile, 1) = Mid(strText, 1, iPosBlank - 1) .Cells(Zeile, 2) = Mid(strText, iPosBlank + 1) Case Is >= 2 iPosBlank = InStr(1, strText, " ") .Cells(Zeile, 1) = Mid(strText, 1, iPosBlank - 1) strText = Mid(strText, iPosBlank + 1) iPosBlank = InStr(1, strText, " ") .Cells(Zeile, 2) = Mid(strText, 1, iPosBlank - 1) .Cells(Zeile, 3) = Mid(strText, iPosBlank + 1) End Select Zeile = Zeile + 1 Loop End With Close #1 Loop Until MsgBox("Weitere Textdatei importieren?", vbYesNo + vbQuestion, "Textdateimport") = vbNo End Sub

Hallo,
hier eine Variante, die Komma und Semicolon verträgt. Hier dürfte die Laufzeit aber deutlich ansteigen, da Zeichen für Zeichen eingelesen wird.


Sub TextImport()
'Importiert den Inhalt einer Textdatei ins aktive Tabellenblatt
Dim wks As Worksheet, strDatei As Variant, strText As String, iLeerzeichen As Integer
Dim Zeile As Long, iPosBlank As Integer, strChr As String
Set wks = ActiveSheet
wks.Cells.ClearContents ' Daten in Tabelle löschen
Zeile = 2 '1. Zeile in die Text eingetragen wird
Do
strDatei = Application.GetOpenFilename(Filefilter:="Textdateien,*.txt", Title:="Textdatei auswählen", MultiSelect:=False)
If strDatei = False Then Exit Sub
Open strDatei For Input As #1
With wks
Do Until EOF(1)
strText = ""
Do Until EOF(1)
strChr = Input(1, #1)
If strChr = vbLf Or strChr = vbCr Then Exit Do
strText = strText & strChr
Loop
If strText = "" Then GoTo weiter1
'    Input #1, strText
'Anzahl Leerzeichen in Zeile
iLeerzeichen = 0
For I = 1 To Len(strText)
If Mid(strText, I, 1) = " " Then
iLeerzeichen = iLeerzeichen + 1
End If
Next I
'Texte in Tabelle eintragen
Select Case iLeerzeichen
Case 0
.Cells(Zeile, 1).Value = strText
Case 1
iPosBlank = InStr(1, strText, " ")
.Cells(Zeile, 1) = Mid(strText, 1, iPosBlank - 1)
.Cells(Zeile, 2) = Mid(strText, iPosBlank + 1)
Case Is >= 2
iPosBlank = InStr(1, strText, " ")
.Cells(Zeile, 1) = Mid(strText, 1, iPosBlank - 1)
strText = Mid(strText, iPosBlank + 1)
iPosBlank = InStr(1, strText, " ")
.Cells(Zeile, 2) = Mid(strText, 1, iPosBlank - 1)
.Cells(Zeile, 3) = Mid(strText, iPosBlank + 1)
End Select
Zeile = Zeile + 1
weiter1:
Loop
End With
Close #1
Loop Until MsgBox("Weitere Textdatei importieren?", vbYesNo + vbQuestion, "Textdateimport") = vbNo
End Sub

Gruß
Franz

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread