Excelde Yinelenen Değerleri Birleştirme

[kkonat10]

Sevgili Arkadaşlar ,

Elimdeki excel doyasında yaklaşık 60bin veri var ve bu hücrelerin çoğu yineleniyor ve karşılıklarında farklı değerler var . Benim yapmak istediğim excel aynı hücereye karşılık gelen satırları aralarına virgül koyarak birleştirsin .

Lütfen resmi inceleyiniz .

[/url][/IMG]

 

[Ömer BARAN]

Merhaba.

Sorunuzu resim yerine,
- cevabımın altındaki İMZA bölümünde yer alan açıklamalar doğrultusunda ekleyeceğiniz-
örnek belge ile desteklemenizin, sonuca ulaşmanızı hızlandıracağını düşünüyorum.
.

 

[Emir Hüseyin Çoban]

. . .

Örnek dosyanın şu şekilde olduğunu varsayarsak, aşağıdaki kodları deneyin.
Sonuçları Sayfa2 ye yazar...

Sub KOD()
    Dim SD As Worksheet: Set SD = Sheets("Sayfa1")
    Dim SO As Worksheet: Set SO = Sheets("Sayfa2")
    Dim dic As Object, liste(), dizi()

    son = SD.Cells(Rows.Count, "A").End(3).Row
    liste = SD.Range("A1:B" & son).Value
    
    ReDim dizi(1 To son, 1 To 2)
    Set dic = CreateObject("scripting.dictionary")
    For x = 1 To UBound(liste, 1)
        aranan = liste(x, 1)
        If Not dic.exists(aranan) Then
            n = n + 1
            dic.Add aranan, n
            ReDim Preserve dizi(1 To son, 1 To 2)
            dizi(n, 1) = liste(x, 1)
        End If
        dizi(dic.Item(aranan), 2) = dizi(dic.Item(aranan), 2) & liste(x, 2) & ","
        
    Next x
    SO.Cells.ClearContents
    SO.Range("A1").Resize(dic.Count, 2) = dizi
    SO.Cells.EntireColumn.AutoFit
    
End Sub

. . .

 

[gulkerpicci]

bu cevap ile hayatımı kurtardınız teşekkürler...

 

[Katip36]

Hocam eski bir konu ama çok işime yaradı. teşekkür ederim.