Hallo Stefan,
Ich kann die Daten in eine Excel-Tabelle ausgeben lassen. Fällt jemandem vielleicht eine Lösung über Excel ein?
ja, in etwa so:
Dim strSuchbegriff As String, strAdresse As String, strErsteZelle As String
Dim objGefunden As Object
Dim lngZ As Long, lngLetzte As Long, lngErste As Long
Dim strTemp As String
lngErste = 2
lngLetzte = Cells(Rows.Count, 1).End(xlUp).Row
For lngZ = lngErste To lngLetzte
strTemp = Cells(lngZ, 2)
If Cells(lngZ, 1) <> "" Then
strSuchbegriff = Cells(lngZ, 1)
Set objGefunden = Columns(1).Find(strSuchbegriff, LookAt:=xlWhole, LookIn:=xlValues)
If Not objGefunden Is Nothing Then
strAdresse = objGefunden.Address(False, False)
strTemp = Cells(objGefunden.Row, 2)
Cells(objGefunden.Row, 2).ClearContents
End If
strErsteZelle = strAdresse
Do
Set objGefunden = Columns(1).Find(strSuchbegriff, LookAt:=xlPart, LookIn:=xlWhole, After:=Range(strAdresse))
If Not objGefunden Is Nothing Then
strAdresse = objGefunden.Address(False, False)
strTemp = strTemp & " " & Cells(objGefunden.Row, 2)
Cells(objGefunden.Row, 2).ClearContents
Else
Exit Do
End If
If strAdresse = strErsteZelle Then Exit Do
Loop
Cells(lngZ, 2) = Trim(strTemp)
End If
Next
For lngZ = lngLetzte To lngErste Step -1
If Cells(lngZ, 2) = "" Then Rows(lngZ).Delete Shift:=xlUp
Next
Die Daten müssen in dem Fall in den Spalten A (ID) und B (andere Texte) ab der Zeile 2 stehen.
Viele Grüße
Jörg