tekrar eden kayıtlar

[krokix]

iyi akşamlar arkadaşlar, çalışmalarınızda başarılar dilerim. bir sorum olacaktı. elimde bir liste var aşağı yukarı 150 kişi kadar, bunların tc kimlik no larına göre sıralanmış ve yan taraflarında kişisel bilgilerir mevcut. fakat bu listede tekrar eden tc kimlik no ları var. istediğim makro ile bu listeyi kontrol ettirip tekrar eden tc kimlik noların bulunduğu satırları silmek. yani tekrar eden ne kadar satır varsa hepsi silinecek. acaba nasıl yapabilirim.

 

[N.Ziya Hiçdurmaz]

yanıt

Kod a sütununa göre yazılmıştır

Sub sil()
Dim sat As Integer
    For sat = Cells(65536, "a").End(xlUp).Row To 1 Step -1
        If WorksheetFunction.CountIf(Range("a1:A" & sat), Cells(sat, "a")) > 1 Then
            Cells(sat, "a").EntireRow.Delete shift:=xlUp
        End If
    Next
End Sub

 

[krokix]

Çok teşekkürederim arkaşadım. eline sağlık.. iyi akşamlar dilerim. peki bu tekrar eden kayıtları siliyor birisi kalıyor. hiç kalmaması için ne yapabiliriz. yani tekrar edenleri tamamen silecek.

 

[krokix]

Hocam ordamısınız acaba.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub sil()
Dim sat As Integer
    For sat = Cells(65536, "a").End(xlUp).Row To 1 Step -1
    If WorksheetFunction.CountIf(Range("a1:A" & sat), Cells(sat, "a")) > 1 Then
    ilksat = WorksheetFunction.Match(Cells(sat, "a"), [a:a], 0)
    Cells(sat, "a").EntireRow.Delete shift:=xlUp
    Cells(ilksat, "a").EntireRow.Delete shift:=xlUp
End If
    Next
End Sub

Not: Dosyanızın bir kopyası üzerinde denemenizi öneririm.

 

[krokix]

Hocam ellerinize sağlık çok teşekkür ederim ilginize. iyi geceler diliyorum. hoşçakalınız...

 

[barshquler]

peki silmesek.. tekrar eden kayıtları arkaplan rengi verebilirmiyiz?

 

[Orion1]

peki silmesek.. tekrar eden kayıtları arkaplan rengi verebilirmiyiz?

BU iş için koşullu biçimlendirme biçilmiş kaftan.En iyisi bence

 

[N.Ziya Hiçdurmaz]

yanıt

Sayın barshquler gölgelendirme örneği ektedir

Sub mukerrerrenkle()
Dim sat As Integer
[a1:a10000].Interior.ColorIndex = xlNone
    For sat = Cells(65536, "a").End(xlUp).Row To 1 Step -1
    If WorksheetFunction.CountIf(Range("a1:A" & sat), Cells(sat, "a")) > 1 Then
    ilksat = WorksheetFunction.Match(Cells(sat, "a"), [a:a], 0)
    Cells(sat, "a").Interior.ColorIndex = 6
    Cells(ilksat, "a").Interior.ColorIndex = 6
End If
    Next
End Sub