Jörg Lorenz: Einträge mit gleicher ID zusammenfügen

Beitrag lesen

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