Bir hücreye @ işareti ile ayırarak birden fazla kod getirme

[Rainbows]

Merhabalar,

formülle bir türlü çözemedigim bir konu var. yapmak istedigim şöyle birşey.

Sheet1 de datalarım varörnegin a kolonunda isimler var b kolonunda kodlar(216555 gibi) var c hücresindede tutarlar var. atıyorum ahmetin 15-20 tane hareketi olabilir bu listede ve her hareket içinde farklı bir kod var.

ben sheet 2 sayfasında a1 hücresinde ahmetin yanına b1 hücresine aralarına @ işareti koyarak kodları getirmek istiyorum. toplam tutarı formülle hallediyorum fakat kodları tek hücrede getiremedim bir türlü. altın üyeligim olmadıgı için örnek dosya ekleyemedim.

yardımcı olursanız sevinirim.

 

[askm]

Örnek dosya eklerseniz yardımcı olmaya çalışalım.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Ozet_Rapor()

    Dim d As Object, i As Long, s, deg

    Set d = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    Sheets("Sayfa1").Select 'verilerin alındığı sayfa adı

    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            s = Cells(i, "B")
            d.Add deg, s
        Else
            s = d.Item(deg)
            s = s & "@" & Cells(i, "B")
            d.Item(deg) = s
        End If
    Next i
  
    Sheets("Sayfa2").Select 'verilerin listeleneceği sayfa adı
    Range("A2:B" & Rows.Count).ClearContents
            
    Range("A2").Resize(d.Count, 2) = _
        Application.Transpose(Array(d.keys, d.items))
        
    Application.ScreenUpdating = True

End Sub

.

 

[Rainbows]

Çok teşekkürler ömer bey, tam istedigim gibi oldu.