benzer olmayan kayıtlar halinde listeleme

[peleryn]

Herkese Merhabalar;

Ek'li dosyamda bir liste içersindeki belli bir kritere göre benzer olma koşulunu sağlayan kayıtların süzülüp bir başka sayfada benzer kayıtlardan her birinin bir defa geçtiği bir liste oluşturma hakkında bir sorum var..Daha ayrıntılı açıklama dosyada mevcuttur.

İlgilenecek olanlara şimdiden çok teşekkür ederim.

 

[hamitcan]

Bence önce bir arama yapın. Bu soru o kadar çok soruldu ki...

 

[peleryn]

hocam hemen her soruda özen gösteriyorum arama yapıyorum.Ancak şu dönem öyle yoğunuz ki arama yapsam bile dosyama uyarlamaya ayıracak çok bir vaktim yok.Yoksa haklısınız çok sık sorulan bir soru olduğunu biliyorum.

Bunlara rağmen ilgilenen olursa çok sevinirim.

 

[Orion1]

Dosyanız ektedir.

Sub mukerrer()
Dim z As Object, i As Long, sat As Long, deg As String, n As Long
Sheets("LİSTE").Select
Set z = CreateObject("Scripting.Dictionary")
ReDim myarr(1 To Cells(65536, "A").End(xlUp).Row, 1 To 6)
For i = 2 To Cells(65536, "A").End(xlUp).Row
    deg = Cells(i, "A").Value & "-" & Cells(i, "C").Value & "-" & Cells(i, "F").Value
    If Not z.exists(deg) Then
        n = n + 1
        z.Add (deg), n
    End If
    myarr(z.Item(deg), 1) = Cells(i, "A").Value
    myarr(z.Item(deg), 2) = Cells(i, "B").Value
    myarr(z.Item(deg), 3) = Cells(i, "C").Value
    myarr(z.Item(deg), 4) = Cells(i, "D").Value
    myarr(z.Item(deg), 5) = Cells(i, "E").Value
    myarr(z.Item(deg), 6) = Cells(i, "F").Value
Next i
Application.ScreenUpdating = False
Sheets("SERVİS").Select
Range("A2:F65536").ClearContents
Range("A2").Resize(n, 6) = myarr
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır." & vbLf & _
vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

End Sub

 

[peleryn]

Evren hocam hamitcan hocam çok haklıydı sizin de bu tarz durumlarda aynı fikirde olduğunuzu forumlarda takip ettiğim diğer mesajlarınızdan biliyorum.Buna rağmen çözüm ürettiğiniz ve paylaştığınız için çok teşekkür ederim.Yoğun bir dönemde bir konuda daha bana zaman kazandırdınız..Ellerinize sağlık çok sağolun..

 

[Orion1]

Evren hocam hamitcan hocam çok haklıydı sizin de bu tarz durumlarda aynı fikirde olduğunuzu forumlarda takip ettiğim diğer mesajlarınızdan biliyorum.Buna rağmen çözüm ürettiğiniz ve paylaştığınız için çok teşekkür ederim.Yoğun bir dönemde bir konuda daha bana zaman kazandırdınız..Ellerinize sağlık çok sağolun..

Evet bende Hamitcan beyle ayni kanaattayim.
İyi çalışmalar dilerim.