Hallo!
Ich habe das Makro von Olaf etwas umgebaut:
Option Explicit
Dim x, trenn As String
Dim posi, laenge, i, r As Integer
Sub test()
trenn = "x" 'hier das Trennzeichen (Kasten)eintragen einfach mit Strg+V
On Error Resume Next
r = 1
Do While Len(ActiveSheet.Cells(r, 2)) > 0
x = ActiveSheet.Cells(r, 2)
i = 3
Do While InStr(1, x, trenn, vbTextCompare) > 0
laenge = Len(x)
posi = InStr(1, x, trenn, vbTextCompare)
ActiveSheet.Cells(r, i) = Mid(x, 1, posi - 1)
x = Mid(x, posi + 1, laenge)
i = i + 1
Loop
r = r + 1
Loop
End Sub
So sollte es funktionieren. Voraussetzung ist, dass die Daten in der Spalte B stehen.
Stevie Wonder schrieb am 09.10.2008 11:50:35:
Hi olaf,
erst einmal vielen Dank für Deine Hilfe - allerdings funktioniert es irgendwie nicht.
Er fängt an zu arbeiten - und hört nich mehr auf..
Darf ich Dir die Datei mal in ein Mail stellen?
Olaf schrieb am 09.10.2008 11:35:50:
Moin Stevie,
verscuh mal das, musst du eventl. noch ein bisschen anpassen.
Option Explicit
Dim x, trenn As String
Dim posi, laenge, i, r As Integer
Option Explicit
Dim x, trenn As String
Dim posi, laenge, i, r As Integer
Sub test()
trenn = "Õ" 'hier das Trennzeichen (Kasten)eintragen einfach mit Strg+V
On Error Resume Next
For r = 1 To 1500 'das musst du dann anpassen jenachdem wieviele Zeilen du hast
x = ActiveSheet.Cells(r, 2)
i = 3
start:
laenge = Len(x)
posi = InStr(1, x, trenn, vbTextCompare)
ActiveSheet.Cells(r, i) = Mid(x, 1, posi - 1)
x = Mid(x, posi + 1, laenge)
If Not Len(x) = 0 Then
i = i + 1
GoTo start
End If
Next r
End Sub
gruß
Olaf |