Hallo kompetentes Forum :),
ich habe bereits folgenden Code erhalten:
Sub kunzi()
Dim objDic As Object
Dim c As Range
Dim vntKeys As Variant
Dim vntItems As Variant
Set objDic = CreateObject("Scripting.Dictionary")
For Each c In Range("B1:B" & Cells(Rows.Count, 1).End(xlUp).Row)
If Not objDic.exists(c.Value) Then
objDic.Add c.Value, c.Offset(, 1).Value
Else
objDic(c.Value) = objDic(c.Value) & "," & c.Offset(, 1).Value
End If
Next
vntKeys = objDic.keys
vntItems = objDic.items
Range("B1:C" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Cells(1, 2).Resize(UBound(vntKeys) + 1) = WorksheetFunction.Transpose(vntKeys)
Cells(1, 3).Resize(UBound(vntItems) + 1) = WorksheetFunction.Transpose(vntItems)
End Sub
Das Ergebnis der Ausfuehrung des Codes sieht so aus
Vorher Codeausfuehrung:
Spalte A Spalte B Spalte C
A1 600 a1
A1 600 a2
A1 600 a3
A2 700 a4
A2 700 a5
Nach Codeausfuerhung:
Spalte A Spalte B Spalte C
A1 600 a1, a2, a3
A1 700 a4, a5
A1
A2
A2
Wo muss ich im Code jetzt was veraendern wenn ne leere Zeile in Spalte B entsteht und ich die entsprechende komplette Zeile geloescht haben will?
Danke im Voraus! Gruss Kunzi
|