Hallo Manzur,
nachfolgend nun nochmal das Makro mit der Sortierung im Blatt Daten.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Sub Test()
Dim lngRow As Long
Dim lngWert As Long
Dim lngRowEnde As Long
Dim lngRowBeginn As Long
Dim lngVerbinden As Long
Dim strKombi As String
Dim lngKomponente As Long
Dim lngFirstRow As Long
Sheets("Daten").Range("A1:B" & Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row).Sort _
Key1:=Sheets("Daten").Range("A2"), Order1:=xlAscending, _
Key2:=Sheets("Daten").Range("B2"), Order2:=xlAscending, Header:=xlGuess
lngWert = Sheets("Daten").Cells(2, 1)
lngRowBeginn = 2
For lngRow = 2 To Sheets("Daten").Cells(Rows.Count, 1).End(xlUp).Row + 1
If Sheets("Daten").Cells(lngRow, 1) <> lngWert Then
lngKomponente = 0
strKombi = ""
lngRowEnde = lngRow - 1
For lngVerbinden = lngRowBeginn To lngRowEnde
If lngKomponente <> Sheets("Daten").Cells(lngVerbinden, 2) Then
strKombi = strKombi & ", " & Sheets("Daten").Cells(lngVerbinden, 2)
End If
lngKomponente = Sheets("Daten").Cells(lngVerbinden, 2)
Next
lngRowBeginn = lngRow
With Sheets("Übersicht")
lngFirstRow = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
.Cells(lngFirstRow, 1) = Sheets("Daten").Cells(lngRowEnde, 1)
.Cells(lngFirstRow, 2) = Mid(strKombi, 3, Len(strKombi))
End With
End If
lngWert = Sheets("Daten").Cells(lngRow, 1)
Next
End Sub
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
