Belli bir sayıdan fazla tekrar eden hücreleri silme

[fatihygz]

Arkadaşlar merhabalar
Çalıştığım tabloda tarih sütununda binlerce tarih var ve aynı tarihte 3 ten fazla olan işlemleri silmem gerekiyor. bunun hızlı bir yolu var mıdır. Teşekkürler
(cevabı forumda bulamadım konuyu yanlış açtıysam özür dilerim)

 

[antonio]

Merhaba,
Durumun daha netlik kazanması için örnek bir dosya eklemeniz daha iyi olur.

 

[fatihygz]

Şöyle özetleyebilirim. Bir sütunda 3 ten fazla tekrar eden satırları silmem gerekiyor. Tekrar rden satırları sil butonu var ancak 3 ten fazla tekrar edenleri nasıl sileceğimi bulamadım . Umarım açıklayıcı olmuştur . Teşekkürler.

 

[antonio]

Hiç değilse 3 ten fazla tekrar ederse silinmesi gereken bilgilerin olduğu sütunun adını belirtseydiniz.

 

[antonio]

Verilerinizin A sütununda olduğu varsayımı ile aşağıdaki kodları hazırladım.
Kendinize göre uyarlayabilirsiniz.

Sub ucden_fazla_olanları_sil()
Dim sh As Worksheet, ss As Long, i As Long, alan As Range, say As Integer, aranan As String

Set sh = Sheets("Sayfa1")
ss = sh.Range("B" & Rows.Count).End(3).Row

For i = ss To 2 Step -1
    Set alan = sh.Range("B2:B" & i)
    aranan = sh.Range("B" & i).Value
    say = WorksheetFunction.CountIf(alan, aranan)
    If say > 3 Then
        sh.Rows(i).EntireRow.Delete
    End If
Next i
MsgBox "İşlem tamamlandı", vbInformation, "antonio"
End Sub

 

[fatihygz]

Kusura bakmayın tekrar soracağım Macro bilmediğim için uyarlayamadım. Resimdeki B sütunu için yapmayı istiyordum sayfa 1 de yer alıyor başlığı "tarih" ve söylediğim gibi tarihlerden 3 ten fazla olan satırları sileceğim.örnek olarak burada 2 eylülden 6 tane var 23 ağustostan 4 tane var.
Zamanınız var ise kullanabileceğim hale getirseniz çok sevinirim işimi çok kısaltacak. Teşekkürler.
https://hizliresim.com/MaoWQ2

 

[çıtır]

Birde bu kodu deneyebilirsiniz.

Sub sil()
For a = [b65536].End(3).Row To 2 Step -1
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("b2:b" & a), Range("b" & a)) > 3 Then Rows(a).Delete
Next
End Sub

 

[fatihygz]

malesef bu kod çalışmadı.

 

[fatihygz]

Maalesef Çıtır bu kod çalışmıyor.

 

[antonio]

5 No'lu Mesajımı B sütununa göre düzenledim.

 

[çıtır]

Sayın fatihygz Resimden şimdi gördüm sayfa adınız Clubcard veya clubcard(2) ve veriler çokfazla 30000 üzeri sayfa adını düzeltirseniz, silmesi uzun sürebilir fakat çalışır.
If WorksheetFunction.CountIf(Sheets("Clubcard").Range("b2:b" & a), Range("b" & a)) > 3 Then
Burdaki ("Sayfa1")Sayfa adınıza göre değiştirmelisiniz.

 

[fatihygz]

Sayın antonio ve çıtır ilginiz yardımınız için çok teşekkür. Çıtır bey dediğiniz gibi kod çalıştı. İyi çalışmalar diliyorum .

 

[çıtır]

Sayın antonio ve çıtır ilginiz yardımınız için çok teşekkür. Çıtır bey dediğiniz gibi kod çalıştı. İyi çalışmalar diliyorum .

Sayın fatihygz dönüş yaptığınız için teşekkür ederim.Kolay gelsin.İyi çalışmalar.