Mükerrre Kayıtlarda Maksimum Değer Atama

[alchemilla]

Merhaba,

aslında tam olarak bu durumu nasıl açıklayacağımı bilmeden sizlerden yardım istemekteyim.

Mükerrer kayıtları silmek için normalde Veri bölümünden yinelenenleri kaldır denildiği takdirde mükerrer tüm kayıtlar silinmektedir. benim istediğim ise mükerrer kayıtlarda sadece bir tane değil maksimum 3 tane kayıt bırakmasını istemekteyim.

daha açık olarak söylemek gerekirse listede aynı koda ait 15 tane kayıt var ama ben bunlardan sadece 3 tanesini istiyorum.ekte gönderdiğim listede bunu uygulamak istediğim bölüm MTKOD bölümüdür.

Şimdiden yardımlarınız için çok teşekkür ederim.

 

[tahsinanarat]

Sub sil()
son = [a65536].End(3).Row - 1
For x = 4 To son
If WorksheetFunction.CountIf(Range("a" & x + 1 & ":a" & son), Cells(x, "a")) >= 3 Then Cells(x, "a") = ""
Next
For x = son To 4 Step -1
If Cells(x, "a") = "" Then Rows(x).Delete
Next

End Sub

 

[muygun]

bir sütunda üçten fazla tekrarlayanları sil

Merhaba;
Syn. tahsinanarat gerekli kodları vermiş ama hazırladığım örnek alternatif olsun.

Sub üçten_fazlasını_sil()
Application.ScreenUpdating = False
For a = [C65000].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("C2:C" & a), Cells(a, "C")) > 3 Then Rows(a).Delete
Next
Application.ScreenUpdating = True
MsgBox "işlem bitti"
End Sub

İyi çalışmalar.

 

[alchemilla]

Sayın tahsinarat ve muygun yardımlarınız için çok teşekkür ederim. çok işime yaradı.