Mükerrer kayıtları listeleme

[mkuru28]

Arkadaşlar kolay gelsin
Ekli çalışma kitabında detaylı olarak anlattığım gibi B sütununda T.C. kimlik numaraları olan bir çalışmam var. B sütunu içerisinde mükerrer girilen T.C. varsa bir buton yardımı ile G sütununa MÜKERRER yazdırmak istiyorum. Binlerce kayıt olacağı için kod ile yapmanın daha uygun olacağını düşündüm.

Ornek dosya

 

[catalinastrap]

Aşağıdaki Kod işinizi çözecektir

Sub MarkDuplicates()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sayfa1")

Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

Dim cell As Range
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

For Each cell In ws.Range("B2:B" & lastRow)
If Not dict.exists(cell.Value) Then
dict.Add cell.Value, 1
Else
ws.Cells(cell.Row, "G").Value = "mükerrer"
End If
Next cell
End Sub

 

[mkuru28]

Hocam çok teşekkür ederim.