Textdatei importieren

Forumthread: Textdatei importieren

07.06.2006 11:36:51

Rainer

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

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Textdatei importieren

07.06.2006 13:06:25

fcs
AW: Textdatei importieren

07.06.2006 14:26:35

Rainer
AW: Textdatei importieren

07.06.2006 14:54:07

fcs

AW: Textdatei importieren

07.06.2006 13:06:25

fcs

Hallo Rainer,
folgendes Makro importiert die Textdatei(en). Voraussetzung: in den Wörten dürfen keine Datensatztrennzeichen wie Komma oder Semikolon vorkommen.

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

mfg
Franz

AW: Textdatei importieren

07.06.2006 14:26:35

Rainer

Hallo,
vielen Dank für die schnelle Antwort. Es funktioniert an sich auch ganz gut. Das Problem ist, dass in den Textdateien teilweise Kommas oder Semikolons enthalten sind und zu Problemen beim Import führen. Gibt es für das Problem eine Lösung?
Gruß
Rainer

AW: Textdatei importieren

07.06.2006 14:54:07

fcs

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)

Forumthread: Textdatei importieren

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread