Tekrarlayan kayıtların düzenlenerek silinmesi ?

[Gorarr]

Selamlar burda ;
İsimlerin karşısında kodları var. Ancak bazı isimler 2,3 veya 4 kez
tekrarlıyor ve farklı kodlar içeriyor.

Yapmam gereken olay;
Birden fazla olan tüm isimlerin tek hale gelmesi ve yan hücrede tüm kodların virgülle ayrılarak yazması. Örnek dosyada da göstermeye çalıştım.

Yardımlarınızı için şimdiden çok çok teşekkürler...

 

[Ömer]

Merhaba,

Bu şekilde denermisiniz.

Sub GrupBulSil()
 
Dim c As Range, ilkadres As Variant, i As Long, son As Long
 
Application.ScreenUpdating = False
On Error Resume Next
 
son = Cells(Rows.Count, "B").End(xlUp).Row
 
ActiveSheet.ShowAllData
Range("B1:C" & son).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
 
For i = son To 2 Step -1
    If Rows(i).EntireRow.Hidden = True Then
        Rows(i).Delete
    End If
Next i
 
For i = Cells(Rows.Count, "B").End(xlUp).Row To 3 Step -1
    With Range("B2:B" & i - 1)
        Set c = .Find(Cells(i, "B"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            ilkadres = c.Address
            Do
                Range("C" & i) = Range("C" & i) & "," & Range("C" & c.Row)
                Rows(c.Row).Delete
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> ilkadres
        End If
    End With
Next i
Application.ScreenUpdating = True
 
End Sub

.

 

[Gorarr]

Tam istediğim gibi ellerineze sağlık. Çok çok teşekkürler..