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?Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen