sutunları satırda birleştirme

[eses06]

arkadaşlar merhaba halledemediğim bir konu var yardımcı olur musunuz kısaca şöyle anlatayım bende aşağıdaki örnekteki gibi bir liste var

a b c sutunlar
xx ad ad
xx ad ad
xx ad ad
yy ad ad
yy ad ad
cc ad ad
... .... ...
bende bu şekilde çok fazla veri olan bir sayfa var ben a satırında yer alan değeri baz alarak b c sutunlarındaki verileri tek hücrede birleştirmek istiyor örneğin xx verisinin yanına b ve c sutununda bulunan bütan ad ları araya virgül atarak tek hücrede birleştirmek istiyor
xx ad,ad,ad,ad gibi bunu formül yardımı yapabilir miyim
şimdiden çok teşekkür ederim

 

[Emir Hüseyin Çoban]

. . .

Birleştir formülünü inceleyiniz.
Birde daha pratik & olanı var... =A10&","&B10&"," gibi...

=BİRLEŞTİR(A10;",";B10;",";C10)

. . .

 

[eses06]

sağol ilginiz için ama benim sorunum şu yukarıdaki görnekteki gibi satırda alt alta yazılmış aynı değerler var önce hepsini süzerek ayırmam sonra aynı değerlerin yanındaki değerleri birleştirmem lazım liste çok uzun olunca pratik bir yolu var mı acaba diye düşündüm ben özet olarak 2-3 değer belirttim aslında değer 1000 tane felan 1000 değeri tek tek süzüp sonra yanlarındaki değerleri birleştirmek uzun zaman olacağı için sormuştum ama yinede teşekkürler

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Verinin 2. satırdan başladığı ve A,B ve C sütunları dikkate alınmıştır.

Özet veriyi de E ve F sütunlarına yazar, siz isterseniz bunu başka bir sütun ya da sayfaya yazdırabilirsiniz.

Sub ozet()

    Dim d
    Dim i As Long
    Dim s
    Dim deg As Variant
    Dim a1
    Dim a2
    
    Set d = CreateObject("Scripting.Dictionary")
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
    
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            s = Cells(i, "B") & "," & Cells(i, "C")
            d.Add deg, s
        Else
            s = d.Item(deg)
            s = s & "," & Cells(i, "B") & "," & Cells(i, "C")
            d.Item(deg) = s
        End If
    Next i
    
    a1 = d.keys
    a2 = d.items
    
    Range("E:F").ClearContents
    Range("E1").Resize(d.Count, 1) = Application.Transpose(a1)
    Range("F1").Resize(d.Count, 1) = Application.Transpose(a2)

End Sub