Excel yinelenen değerler hk.

[furkanosman]

Merhaba sayın hocalarım. Bir sorunum var yardımcı olabilirseniz sevinirim

Excel de şöyle bir tablom var.




A--------B
123 3935
123 4828
123 5839
123 4728
124 3848
124 4939
124 1095

Bu tabloda A sütununda yinenlenen değerlerden bazıları 3 tane bazıları 4 veya sadece 2 tane Ben bu yinenlenen değerlerden atıyorum 4 tane yinelenenden son 2 satırı bırakmak istiyorum. Yani tüm yinelenen değerlerde son iki satır kalsın istiyorum. Üsttekiler silinsin. Zaten 2 taneyse dokunmasın.


A--------B
123 5839
123 4728
124 4939
124 1095

Sonuc böyle olsun. A sütununa bakarak yinelenen grupta
Son iki satır kalsın.

Şimdiden çok teşekkür ederim.

Sub MÜKERRER_KAYITLARI_SİL()
    For X = [A65536].End(3).Row To 1 Step -1
    If WorksheetFunction.CountIf(Range("A1:A" & X), Cells(X, "A")) > 2 Then Rows(X).Delete
    Next
    MsgBox "MÜKERRER KAYITLAR SİLİNMİŞTİR.", vbInformation
End Sub

Bu kodu buldum işe yaradı fakat tekrarlı gurupdaki son satırları siliyor. ilk satırlar gitsin istiyorum.

 

[çıtır]

Bu şekilde değiştirin (-1) 1 yapın
For X = [A65536].End(3).Row To 1 Step 1

 

[furkanosman]

Bu şekilde değiştirin (-1) 1 yapın
For X = [For X = [A65536].End(3).Row To 1 Step 1].End(3).Row To 1 Step 1

Cevabınız için çok teşekkür ederim.

Bu şekilde değiştirdim fakat hiçbirşey silmedi. Anladıpım kadarıyla 1 yapınca bir-bir ileri gitmeye çalıştı fakat gidemedi. Çünkü ilk hücre olarak zaten A65536 bu var daha ilerisi yok zannımca.

For X = [A1].End(3).Row To 65536 Step 1

Bunu denedim yine son satırları siliyor. Enteresan

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub MÜKERRER_KAYITLARI_SİL()
    son = Cells(Rows.Count, "A").End(3).Row
    For X = son To 1 Step -1
        If WorksheetFunction.CountIf(Range("A" & X & ":A" & son), Cells(X, "A")) > 2 Then Rows(X).Delete
    Next
    MsgBox "MÜKERRER KAYITLAR SİLİNMİŞTİR.", vbInformation
End Sub

 

[furkanosman]

Aşağıdaki gibi deneyin:

Sub MÜKERRER_KAYITLARI_SİL()
    son = Cells(Rows.Count, "A").End(3).Row
    For X = son To 1 Step -1
        If WorksheetFunction.CountIf(Range("A" & X & ":A" & son), Cells(X, "A")) > 2 Then Rows(X).Delete
    Next
    MsgBox "MÜKERRER KAYITLAR SİLİNMİŞTİR.", vbInformation
End Sub

Çok teşekkür ederim hocam. İşe yaradı.

Bu kodu bi açıklayabilrmisiniz kısaca ne yapıyor?

 

[YUSUF44]

İlk kodla aynı. Sadece satır silerken önceki satırlara değil kendisinden sonraki satırlara bakıyor. En son olan 2 satırın kalmasını, daha yukarda olanların silinmesini istediğiniz için kendisinden sonra aynı koddan 2 tane olan satırı siliyor.

 

[yenilik025]

Aşağıdaki gibi deneyin:

Sub MÜKERRER_KAYITLARI_SİL()
    son = Cells(Rows.Count, "A").End(3).Row
    For X = son To 1 Step -1
        If WorksheetFunction.CountIf(Range("A" & X & ":A" & son), Cells(X, "A")) > 2 Then Rows(X).Delete
    Next
    MsgBox "MÜKERRER KAYITLAR SİLİNMİŞTİR.", vbInformation
End Sub

Hocam merhabalar bende bunun herhangi bir silme ya da renklendirme yapmadan mesaj olarak vermesini istiyorum ancak burada da
C5 : T500 Arasında çalışmasını istiyorum kodun nasıl yapabilirim ? Nasıl değiştirmeliyim.

Aşağıdaki kodu
sonsatir = Sheets("Sınav Programı").Range("B500").End(3).Row
For i = 1 To sonsatir
If WorksheetFunction.CountIf(Range("B5:B" & i), Range("C" & i).Value) > 1 Then
MsgBox "Mükerrer Kayıt Var!" & " " & Range("B" & i).Row & ".satır"
Exit Sub
End If
Next i
ActiveCell.Select

 

[Korhan Ayhan]

Örnek dosya paylaşırsanız yardım almanız kolaylaşır.