txt-import

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

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

<pre>
Wert_1 Wert_2 Wert_3...
10001   XY     555
XY    666
XY    756
</pre>
erscheint es auch so:
Wert_1 Wert_2 Wert_3...
10001   XY     555
XY    666
XY    756

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