Aynı kişilere ait metinleri birleştirme

[qbilay06]

Merhaba,

E sütunundaki metin alanına;

A sütunundaki isimlere göre aynı isimlerin karşısındaki metinleri tek hücre içinde

yazdırmak istiyorum.


Birleştir, indis ve kaçıncı formülleri ile yapmaya çalışsam da başarılı olamadım.

İlgilenenlere şimdiden teşekkür ederim.

Sağlıkla kalın.

 

[Erdem Akdemir]

Merhaba,

Boş bir modüle ktf kodunu ekleyin,

Function birles(alan As Range, hedef As Range)

Application.Volatile
For Each x In alan

If x = hedef Then

sonuc = sonuc & " " & x.Offset(0, 1)

End If

Next

birles = VBA.Trim(sonuc)
End Function

kullanımı

=birles(alan;hedef)

alan kısmına isimleri tarayın, hedef kısmına istenendeki tek hücreyi tıklayın ve diğer hücrelere uygulayın.

Yerleşik fonksiyonlarla bir kerede yapmak imkansız, yardımcı sütun kullanmak gerekir.

 

[qbilay06]

Teşekkür ederim Kuvari,

çözümü fonksiyonlar yardımı ile neticelendirme imkanımız olabilir mi?

 

[bzace]

Merhabalar,
Formüller ile yapmak mümkündür. Gerektiği kadar yardımcı sütun yada bir formülün içerisinde aynı döngüyü döndürmek yeterlidir.

Bu dediklerim harici formüller ile yapılamaz.

 

[veyselemre]

Fonkisoyonlarla çözüm istenmiş ama, örnek olması açısından ekledim.

Sub grupla()
   Range("d3:e" & Rows.Count).ClearContents
    al = Range("A3:B" & Cells(Rows.Count, 1).End(3).Row)
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(al, 1)
            .Item(al(i, 1)) = Trim(.Item(al(i, 1)) & " " & al(i, 2))
        Next i
        [d3].Resize(.Count).Value = Application.Transpose(.keys)
        [e3].Resize(.Count).Value = Application.Transpose(.items)
    End With
    Erase al
End Sub

 

[carpediems]

Merhaba. Deneyebilir misiniz?

 

[qbilay06]

Merhaba,

"bzace", "veyselemre" ve "carpediem" isimli üye arkadaşlara çok teşekkür ederim.

carpediem tarafından eklenen dosyadaki, formülleri kendime göre düzenleyerek sonucu aldım.

Sağlıkla kalın.