ich würde gerne die einer Dok Nr zugeordneten Werte in einer Zelle zusammenfassen und Dok.Nr. sortiert auflisten lassen (siehe Anhang)
Vorab vielen Dank für Eure Hilfe!!!
https://www.herber.de/bbs/user/122902.xlsx
Sub a()
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim WsQ As Worksheet: Set WsQ = Wb.Worksheets("Tabelle1")
Dim WsZ As Worksheet: Set WsZ = Wb.Worksheets("Tabelle2")
Dim Dic As Object, aIn, aOut(), i&, j&, k
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
With WsQ
aIn = .Range(.Cells(2, 1), .Cells(.Rows.Count, 2).End(xlUp))
For i = LBound(aIn, 1) To UBound(aIn, 1)
If Not Dic.exists(aIn(i, 2)) Then
Dic.Add aIn(i, 2), aIn(i, 1) & "; "
Else:
Dic(aIn(i, 2)) = Dic(aIn(i, 2)) & aIn(i, 1) & "; "
End If
Next i
End With
ReDim aOut(1 To Dic.Count, 1 To 2)
For Each k In Dic.keys
j = j + 1: aOut(j, 1) = k: aOut(j, 2) = Dic(k)
Next k
With WsZ
.Range(.Cells(2, 1), .Cells(UBound(aOut, 1) + 1, 2)) = aOut
End With
Set Wb = Nothing: Set WsQ = Nothing: Set WsZ = Nothing
Set Dic = Nothing: Erase aIn: Erase aOut
End Sub
Passt?