birden fazla sütundaki mükerrer kayıtlar

[ayannn]

arkadaşlar benim yapmak istediğim olay 3 sütunum var a-b-c sütünlarımda birbirini tekrarlayabilen kayıtlar mevcut. elde etmek istediğim ise c sütünunu baz alarak yani bir sheet e mükerrer olan kayıtları bir defa ve eşsiz olan kayıtları tekrar yeni sheete a-b-c sütünuna satır satır eklemek. mükerrer kayıt örneklerine bakındım istediğim olayı bulamadım kendim bişeyler yapmaya çalıştım sadece tek sütünda becerebildim 3 sütün birden alamadım. ekte örnek dosya koydum. şimdiden yardımlarınız için çok teşekkürler.

 

[Necdet]

İyi geceler sayın ayannn,

Sizin sorununuz gelişmiş süz ile çözülebilir, ekteki dosyayı inceleyiniz

 

[N.Ziya Hiçdurmaz]

yanıt

Makrolu çözüm.

Sub test()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
s2.[a1:k10000].ClearContents
For sut = s1.[c65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(s1.Range("c1:c" & sut), Range("c" & sut)) = 1 Then
s1.Range("c" & sut).EntireRow.Copy
s = s + 1
s2.Range("a" & s).PasteSpecial
End If
Next
Application.CutCopyMode = False
End Sub

 

[ayannn]

Necdet Bey,

Gelişmiş süz ile sizin dediğiniz gibi deniyorum fakat ya tek sütunu atıyor yada kaynak olan 3 sütunu olduğu gibi kopyalıyor. bir türlü beceremedim.

 

[ayannn]

Makrolu çözüm.

Sub test()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("sayfa2")
s2.[a1:k10000].ClearContents
For sut = s1.[c65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(s1.Range("c1:c" & sut), Range("c" & sut)) = 1 Then
s1.Range("c" & sut).EntireRow.Copy
s = s + 1
s2.Range("a" & s).PasteSpecial
End If
Next
Application.CutCopyMode = False
End Sub

çok teşekkür ederim hem necdet beye hemde V.Basic For Applications a, fakat kod içersinde anlayamadığım birşeyler var birincisi acayip şekilde ağpar çalışıyor (elimdeki kayıt 9000 satır civarında) ayrıca sadece 42 satır yapıp kendini tekrarlıyor. yardımlarınız için çok teşekkür ederim.