Sub Osma()
Set dic = CreateObject("Scripting.Dictionary")
veriler = Range("a1:D" & Cells(Rows.Count, 1).End(3).Row).Value
With dic
For i = 1 To UBound(veriler)
anahtar = veriler(i, 1)
veri = veriler(i, 4)
If Not .exists(anahtar) Then
.Add anahtar, anahtar & "|" & veri & "|"
Else
.Item(anahtar) = .Item(anahtar) & veri & "|"
End If
Next i
liste = .items
End With
Range("$f$1:" & Cells(Rows.Count, Columns.Count).Address).ClearContents
Set Rng = Range("f1")
For Each lst In liste
ver = Split(Left(lst, Len(lst) - 1), "|")
Rng.Resize(, UBound(ver) + 1).Value = ver
Set Rng = Rng.Offset(1)
Next
Columns.AutoFit
Set dic = Nothing: Set Rng = Nothing
End Sub