AW: Extrahieren zum 10.
22.01.2007 13:35:06
praetorius
Hallo Venen0,
freut mich, dass mein Vorschlag so gut ankommt. Ich habe den Code etwas modifiziert. Im mittleren Teil werden jetzt die Teile solange aneinander gehängt und durch Leerzeichen getrennt, bis im nächsten Teil als erstes Zeichen ein Pluszeichen erscheint. Die Schleife habe ich auch eingefügt.
Option Explicit
Sub test()
'Biek Claudia PG O 3 BLN DE +49 (31) 3464-4599 claudia.biek@fruchtsaft.com
'Brume Klaus FED ZENTRAL DE +49 (9232) 84-8296 klaus.brume@fruchtsaft.com
Dim Tabelle As Worksheet
Set Tabelle = ThisWorkbook.Sheets(1)
Dim inhalt, angabe As String
Dim a As Variant
Dim i, zeile As Integer
Dim gefunden As Range
zeile = 1
'Die Range-Variable sucht in der Spalte A die erste leere Zelle
'Ich gehe davon aus, dass A immer belegt ist. Trifft dies nicht für A, sondern
'für eine andere Spalte zu, muss angepasst werden.
Set gefunden = Tabelle.Columns("A").Find("")
'Nur Fehlerbehandlung, sollte obsolet sein
If Not gefunden Is Nothing Then
'und letzt die Schleife
'Annahme: in Zeile 1 stehen Überschriften, deshalb erst ab Zeile 2
For zeile = 2 To gefunden.Row
'Hier angebn, wo der Datensatz herkommt, z.B.
inhalt = Tabelle.Range("A" & zeile).Value
' inhalt = "Brume Klaus FED ZENTRAL DE +49 (9232) 84-8296 klaus.brume@fruchtsaft.com"
a = Split(inhalt, " ")
Tabelle.Range("A" & zeile).Value = a(0)
Tabelle.Range("B" & zeile).Value = a(1)
angabe = ""
i = 2
Do While Left(a(i), 1) <> "+"
angabe = angabe & a(i) & " "
i = i + 1
Loop
Tabelle.Range("C" & zeile).Value = angabe
Tabelle.Range("D" & zeile).Value = a(i) & a(i + 1) & a(i + 2)
Tabelle.Range("E" & zeile).Value = a(i + 3)
Next zeile
End If
End Sub
Sag mal Bescheid, ob es geklappt hat.
good luck