txt-import

hallo,

Ich habe ein größeres txt-file. Nun gibt es ja feine makros die es mir ermöglichen diese beliebig zu importieren. Jetzt habe ich nur leider ein problem. In dieser text tabelle werden die informationen wie folgt dargestellt

Nr_1 Text_1 Nr._2 Text_2 ert_1 Wert_2 Wert_3

Ich benötige aus dem File eigentlich nur die Werte aus Nr_1, Nr_2 und Wert_3

Das einzige Problem ist, das die Nr_1 und die Nr_2 erst eine einheitliche Zurodnung ermöglichen, die Werte der Nr_1 jedoch nicht durchgehend gelistet werden. Das sieht wie folgt aus:

Nr_1 Text_1 Nr._2 Text_2 Wert_1 Wert_2 Wert_3
10001 XY 555 XY 100 200 150
XY 666 XY 100 200 150
XY 777 XY 100 200 150
10002 XY 555 XY 100 200 150
XY 666 XY 100 200 150
.....

Das Problem ist nun, wie bekomme ich die Nr._1 durchgehend in den Spalten eingetragen, denn die Werte aus Nr_2 kommen häufiger vor und sind somit nicht direkt zuordnenbar.
Es sollte dann wie folgt aussehen, mit solchen Daten ist der Import für mich im Rahmen meiner Fähigkeiten wieder möglich.

Nr_1 Text_1 Nr._2 Text_2 Wert_1 Wert_2 Wert_3
10001 XY 555 XY 100 200 150
10001 XY 666 XY 100 200 150
10001 XY 777 XY 100 200 150
10002 XY 555 XY 100 200 150
10002 XY 666 XY 100 200 150

Vielen Dank

Gruß

Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim Zeile As Integer Dim Textzeile As String Dim n As Integer Dim Prüf As Variant Zeile = 2 Close Open "c:\temp\tesst.txt" For Output As #1 Print #1, "10001 XY 555 XY 100 200 150" Print #1, "XY 666 XY 100 200 150" Print #1, "XY 777 XY 100 200 150" Print #1, "10002 XY 555 XY 100 200 150" Print #1, "XY 666 XY 100 200 150" Close #1 Open "c:\temp\tesst.txt" For Input As #2 Range("a1:g65536").ClearContents While Not EOF(2) Input #2, Textzeile Cells(Zeile, 1) = Textzeile Zeile = Zeile + 1 Wend Close #2 Range(Cells(2, 1), Cells(Zeile - 1, 1)).Select Selection.TextToColumns Destination:=Range("a2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ Array(7, 1)) 'Prüf = Range("a2") For n = 2 To Zeile - 1 If IsNumeric(Cells(n, 1)) Then Prüf = Cells(n, 1) Else Range(Cells(n, 1), Cells(n, 7)).Cut Cells(n, 2).Select ActiveSheet.Paste Cells(n, 1) = Prüf End If Next n Range("a1").Select End Sub

Hallo Stefan,
die folgenden Zeilen kannst du streichen, sie dienten nur zum Anlegen der Testdatei tesst.txt.

Open "c:\temp\tesst.txt" For Output As #1
Print #1, "10001 XY 555 XY 100 200 150"
Print #1, "XY 666 XY 100 200 150"
Print #1, "XY 777 XY 100 200 150"
Print #1, "10002 XY 555 XY 100 200 150"
Print #1, "XY 666 XY 100 200 150"
Close #1

Diese Zeile musst du umschreiben, also Pfad und Dateinamen deiner datei angeben:
Open "c:\temp\tesst.txt" For Output As #1

Gruß
Reinhard


Sub test()
Dim Zeile As Integer
Dim Textzeile As String
Dim n As Integer
Dim Prüf As Variant
Zeile = 2
Close
Open "c:\temp\tesst.txt" For Output As #1
Print #1, "10001 XY 555 XY 100 200 150"
Print #1, "XY 666 XY 100 200 150"
Print #1, "XY 777 XY 100 200 150"
Print #1, "10002 XY 555 XY 100 200 150"
Print #1, "XY 666 XY 100 200 150"
Close #1
Open "c:\temp\tesst.txt" For Input As #2
Range("a1:g65536").ClearContents
While Not EOF(2)
Input #2, Textzeile
Cells(Zeile, 1) = Textzeile
Zeile = Zeile + 1
Wend
Close #2
Range(Cells(2, 1), Cells(Zeile - 1, 1)).Select
Selection.TextToColumns Destination:=Range("a2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1))
For n = 2 To Zeile - 1
If IsNumeric(Cells(n, 1)) Then
Prüf = Cells(n, 1)
Else
Range(Cells(n, 1), Cells(n, 7)).Cut
Cells(n, 2).Select
ActiveSheet.Paste
Cells(n, 1) = Prüf
End If
Next n
Range("a1").Select
End Sub

Danach folgen viele Blöcke, wobei jeder Block bzw. dessen Zeilen so aufgebaut sind: 8 Eintragungen der Form: 123 abc 234 def ghi jkl mno pqr mehrere Eintragungen der Form: 234 def ghi jkl mno pqr Einen Eintrag der Form: xyz def ghi jkl mno pqr Nach dem Makro soll das dann so aussehen:? 123 abc 234 def ghi jkl mno pqr 123 abc 234 def ghi jkl mno pqr 123 abc 234 def ghi jkl mno pqr 123 abc 234 def ghi jkl mno pqr 123 abc xyz def ghi jkl mno pqr Oder so:? 123 234 pqr 123 234 pqr 123 234 pqr 123 234 pqr 123 xyz pqr

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread