Bir sütundaki alt alta verileri tek hücrede metin haline getirme

[theknife14]

Merhaba. Bir sütundaki değerleri, tekrar etme adedi ile birlikte tek metin haline getirmek için makro yardımı yapabilir misiniz ?
Linkte örnek paylaşıyorum.

İndir Ornek

Dosyayı indir Ornek

dosya.co

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Yaz()

    Dim d As Object, i As Long, deg, a1, a2
    
    Set d = CreateObject("Scripting.Dictionary")
    
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            d.Add deg, 1
        Else
            d.Item(deg) = d.Item(deg) + 1
        End If
    Next i
    
    [D5] = ""
    a1 = d.keys: a2 = d.items
    For i = 0 To d.Count - 1
        If [D5] = "" Then [D5] = a1(i) & " " & a2(i)
        [D5] = [D5] & " ," & a1(i) & " " & a2(i)
    Next i
    
End Sub