Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1008to1012
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Textdatei in Excel importieren und umgestalten.

Textdatei in Excel importieren und umgestalten.
18.09.2008 13:18:02
Pascal
Hallo allerseits
Dank Diesem tollen Code hier unten, welchen ich übrigens hier im Forum erhalten hatte versuche ich eine komplizierte Textdatei im Excel umzugestalten.
Die Textdatei ist sehr gross und hat folgende Inhalte:
Aufteiler 0000265614 ,Position 00010
Bestellposition für: Material: 000000000003714901, Werk: 4251 wurde nicht angele
Status "gesp. für Beschaffung" des Materials 3.714.901 erlaubt keine externe Bes
Einkaufsorg. CP01, Buchungskreis CG01, Bestellart UB, abgeb. Werk 9017
Aufteiler 0000265614 ,Position 00010
Bestellposition für: Material: 000000000003714901, Werk: 4253 wurde nicht angele
Status "gesp. für Beschaffung" des Materials 3.714.901 erlaubt keine externe Bes
Einkaufsorg. CP01, Buchungskreis CG01, Bestellart UB, abgeb. Werk 9017
Aufteiler 0000265614 ,Position 00010
Bestellposition für: Material: 000000000003714901, Werk: 4255 wurde nicht angele
Status "gesp. für Beschaffung" des Materials 3.714.901 erlaubt keine externe Bes
Einkaufsorg. CP01, Buchungskreis CG01, Bestellart UB, abgeb. Werk 9017
Aufteiler 0000265614 ,Position 00010
Bestellposition für: Material: 000000000003714901, Werk: 4257 wurde nicht angele
Status "gesp. für Beschaffung" des Materials 3.714.901 erlaubt keine externe Bes
Einkaufsorg. CP01, Buchungskreis CG01, Bestellart UB, abgeb. Werk 9017
Es soll nun alles schön fein säuberlich in Zeilen (NICHT SPALTEN !) aufgeteilt werden:

Sub umgestalten()
Dim i As Long
'--- Zusammenfassen
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Left(Cells(i, 1), 12)  "Aufteiler" Then
Cells(i - 1, 1).Value = Cells(i - 1, 1).Value & "," & Cells(i, 1).Value
Rows(i).Delete
End If
Next
'--- Trennzeichen ergänzen (bei Bedarf erweitern)
With Columns(1)
.Replace "Aufteiler", "Aufteiler,", xlPart
.Replace ",Position", ",Position,", xlPart
.Replace "Bestellposition für: Material:", "Bestellposition für: Material:,", xlPart
.Replace "Werk:", "Werk,", xlPart
.Replace "wurde nicht angele", ",wurde nicht angelegt", xlPart
' bei Bedarf weiterführen
'.Replace ", ", ",", xlPart
End With
'--- Text in Spalten aufteilen
Columns(1).TextToColumns _
Destination:=Range("A1"), _
DataType:=xlDelimited, _
Comma:=True
End Sub


Dieser Code funktioniert schon recht gut, ausser dass mir der Text "wurde nicht angele
Status "gesp. für Beschaffung" des Materials 3.714.901 erlaubt keine externe Bes
Einkaufsorg. CP01, Buchungskreis CG01, Bestellart UB, abgeb. Werk 9017"
gleichwohl in einzelne Zellen, statt in eine Zeile aufgeteilt wird.
D.h. es soll also (gemäss obigem Code) .Replace "wurde nicht angele", ",wurde nicht angelegt", xlPart
nicht mehr in weitere Zellen unterteilt- sondern der Rest des Datensatzes in die gleiche Zelle geschrieben werden.
Jeder Datensatz beginnt beim Wort "Aufteiler"
Mein Problem ist nun auch, dass ich nicht schön Zeile um Zeile schön untereinander in Excel erhalte, sondern alles auf einer Zeile hintereinander geschrieben wird.
Wie müsste ich also den Code ändern / ergänzen, damit ich folgendes noch erreiche:
- Jeder Datensatz (immer mit dem Wort "Aufteiler" beginnend hat eine separate Zeile
- nach der Werksnummer (abgeb. Werk XXXX) soll rest des Datensatzes in gleicher Zelle stehen
- Textfile soll nicht zuerst in Excel kopiert werden müssen, sondern soll über ein Dialogfenster ausgewählt werden können.
WÄHRE SUPERNETT, WENN MIR HIER JEMAND WEITERHELFEN KÖNNTE !!!!
meine VBA - Kenntnisse sind da am "Anschlag" und müssen weiter ausgebaut werden :-)

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

Betreff
Datum
Anwender
Anzeige
AW: Textdatei in Excel importieren und umgestalten.
18.09.2008 17:48:00
fcs
Hallo Pascal,
hier eine modifizierte Variante, die die Daten etwas übersichtlicher direkt aus der Textdatei einliest.
Gruß
Franz

Sub DateiImport()
Dim varDatei, strText As String, arrTemp As Variant, intI As Integer
Dim intFF As Integer, wks As Worksheet, lngZeile As Long, intLine As Integer
Dim strSp1$, strSp2$, strSp3$, strSp4$, strSp5$
Dim strSp6$, strSp7$, strSp8$, strSp9$, strSp10$
On Error Resume Next 'überspringt einlesen unvollständiger Zeilen
'Textdatei auswählen
varDatei = Application.GetOpenFilename(Filefilter:="Texte(*.txt),*.txt", Title:="Bitte  _
datendatei öffnen")
If varDatei = False Then Exit Sub
Set wks = ActiveSheet
lngZeile = 1
With wks
'Spaltentitel eintragen
.Cells(lngZeile, 1) = "Aufteiler"
.Cells(lngZeile, 2) = "Position"
.Cells(lngZeile, 3) = "Bestellposition für: Material"
.Cells(lngZeile, 4) = "Werk"
.Cells(lngZeile, 5) = "Sonstiges"
.Cells(lngZeile, 6) = "Status"
.Cells(lngZeile, 7) = "Einkaufsorg"
.Cells(lngZeile, 8) = "Buchungskreis"
.Cells(lngZeile, 9) = "Bestellart"
.Cells(lngZeile, 10) = "abgeb. Werk"
'Spalten formatieren
.Range(.Columns(1), .Columns(10)).VerticalAlignment = xlVAlignTop
.Range(.Columns(1), .Columns(5)).AutoFit
.Range(.Columns(5), .Columns(6)).WrapText = True
.Columns(5).ColumnWidth = 20
.Columns(6).ColumnWidth = 40
.Range(.Columns(7), .Columns(10)).AutoFit
End With
intFF = FreeFile()
Open varDatei For Input As #intFF
Do Until EOF(intFF)
Line Input #intFF, strText
If Left(strText, 9) = "Aufteiler" Then 'Zeile 1 aufbereiten
arrTemp = Split(strText, ",")
strSp1 = Trim(arrTemp(0))
strSp2 = Trim(arrTemp(1))
intLine = 1
ElseIf Left(strText, 8) = "Bestellp" Then 'Zeile 2 aufbereiten
arrTemp = Split(strText, ",")
strSp3 = Trim(arrTemp(0))
strSp4 = Left(Trim(arrTemp(1)), 10)
strSp5 = Trim(Mid(arrTemp(1), 12))
strSp5 = VBA.Replace(strSp5, "wurde nicht angele", "wurde nicht angelegt ", 1)
intLine = 2
ElseIf Left(strText, 6) = "Status" Then 'Zeile 3 aufbereiten
intLine = 3
strSp6 = Trim(strText)
ElseIf Left(strText, 11) = "Einkaufsorg" Then  'Zeile 4 aufbereiten
arrTemp = Split(strText, ",")
strSp7 = Trim(arrTemp(0))
strSp8 = Trim(arrTemp(1))
strSp9 = Trim(arrTemp(2))
strSp10 = Trim(arrTemp(3))
intLine = 4
Else
'do nothing
End If
If intLine = 4 Then '4. Zeile des Datensatzes ist eingelesen
'Daten in Tabelle schreiben
lngZeile = lngZeile + 1
With wks
'führende Nullen bleiben erhalten
.Cells(lngZeile, 1) = "'" & VBA.Replace(strSp1, "Aufteiler ", "", 1)
.Cells(lngZeile, 2) = "'" & VBA.Replace(strSp2, "Position ", "", 1)
.Cells(lngZeile, 3) = "'" & VBA.Replace(strSp3, "Bestellposition für: Material: ", _
"", 1)
.Cells(lngZeile, 4) = "'" & VBA.Replace(strSp4, "Werk: ", "", 1)
'oder ohne führende Nullen
.Cells(lngZeile, 1) = VBA.Replace(strSp1, "Aufteiler ", "", 1)
.Cells(lngZeile, 2) = VBA.Replace(strSp2, "Position ", "", 1)
.Cells(lngZeile, 3) = VBA.Replace(strSp3, "Bestellposition für: Material: ", "", 1)
.Cells(lngZeile, 4) = VBA.Replace(strSp4, "Werk: ", "", 1)
.Cells(lngZeile, 5) = strSp5
.Cells(lngZeile, 6) = Mid(strSp6, 8) '"Status " am Anfang abtrennen
.Cells(lngZeile, 7) = VBA.Replace(strSp7, "Einkaufsorg. ", "", 1)
.Cells(lngZeile, 8) = VBA.Replace(strSp8, "Buchungskreis ", "", 1)
.Cells(lngZeile, 9) = VBA.Replace(strSp9, "Bestellart ", "", 1)
.Cells(lngZeile, 10) = VBA.Replace(strSp10, "abgeb. Werk ", "", 1)
'Zurücksetzen der Variablen
strSp1 = "": strSp2 = "": strSp3 = "":  strSp4 = "": strSp5 = ""
strSp6 = "": strSp7 = "": strSp8 = "": strSp9 = "": strSp10 = ""
intLine = 0
End With
End If
Loop
Close #intFF
End Sub


Anzeige
AW: Textdatei in Excel importieren und umgestalten.
18.09.2008 15:55:00
fcs
Hallo Pascal,
das folgende Makro bereitet das Textfile komplett beim einlesen auf und trägt die Daten ins aktive Tabellenblatt ein.
Gruß
Franz

Sub DateiImport()
Dim varDatei, strText As String, arrTemp As Variant, intI As Integer
Dim intFF As Integer, wks As Worksheet, lngZeile As Long, intLine As Integer
Dim strSp1$, strSp2$, strSp3$, strSp4$, strSp5$
'Textdatei auswählen
varDatei = Application.GetOpenFilename(Filefilter:="Texte(*.txt),*.txt", Title:="Bitte  _
datendatei öffnen")
If varDatei = False Then Exit Sub
Set wks = ActiveSheet
lngZeile = 1
With wks
'Spaltentitel eintragen
.Cells(lngZeile, 1) = "Aufteiler"
.Cells(lngZeile, 2) = "Position"
.Cells(lngZeile, 3) = "Bestellposition für: Material"
.Cells(lngZeile, 4) = "Werk"
.Cells(lngZeile, 5) = "Sonstiges"
'Spalten formatieren
.Range(.Columns(1), .Columns(5)).VerticalAlignment = xlVAlignTop
.Range(.Columns(1), .Columns(4)).AutoFit
.Columns(5).ColumnWidth = 40
.Columns(5).WrapText = True
End With
intFF = FreeFile()
Open varDatei For Input As #intFF
Do Until EOF(intFF)
Line Input #intFF, strText
If Left(strText, 9) = "Aufteiler" Then 'Zeile 1 aufbereiten
arrTemp = Split(strText, ",")
strSp1 = Trim(arrTemp(0))
strSp2 = Trim(arrTemp(1))
strSp5 = ""
intLine = 1
ElseIf Left(strText, 8) = "Bestellp" Then 'Zeile 2 aufbereiten
arrTemp = Split(strText, ",")
strSp3 = Trim(arrTemp(0))
strSp4 = Left(Trim(arrTemp(1)), 10)
strSp5 = Trim(Mid(arrTemp(1), 12))
strSp5 = VBA.Replace(strSp5, "wurde nicht angele", "wurde nicht angelegt ", 1)
intLine = 2
Else 'Zeile 3 + 4 aufbereiten
strSp5 = strSp5 & strText
intLine = intLine + 1
End If
If intLine = 4 Then '4. Zeile des Datensatzes ist eingelesen
'Daten in Tabelle schreiben
lngZeile = lngZeile + 1
With wks
'führende Nullen bleiben erhalten
.Cells(lngZeile, 1) = "'" & VBA.Replace(strSp1, "Aufteiler ", "", 1)
.Cells(lngZeile, 2) = "'" & VBA.Replace(strSp2, "Position ", "", 1)
.Cells(lngZeile, 3) = "'" & VBA.Replace(strSp3, "Bestellposition für: Material: ", "",  _
1)
.Cells(lngZeile, 4) = "'" & VBA.Replace(strSp4, "Werk: ", "", 1)
.Cells(lngZeile, 5) = strSp5
'oder ohne führende Nullen
.Cells(lngZeile, 1) = VBA.Replace(strSp1, "Aufteiler ", "", 1)
.Cells(lngZeile, 2) = VBA.Replace(strSp2, "Position ", "", 1)
.Cells(lngZeile, 3) = VBA.Replace(strSp3, "Bestellposition für: Material: ", "", 1)
.Cells(lngZeile, 4) = VBA.Replace(strSp4, "Werk: ", "", 1)
.Cells(lngZeile, 5) = strSp5
End With
End If
Loop
Close #intFF
End Sub


Anzeige

305 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige