Çift Telefon Numaralarını Silme

[osmankul]

541 378 14 78
5384381822
538 3344636
5322000203
53687 15 162
5554635266
5323967069
536 5653 333
5336604416
5332145288
555 5 231895
536 5012 708
5054873279
539 8576 217
5322737651
5335822133
5363652070
5547951969

Uzun uzadıya giden 13000 satıra yakın bir telefon listem var.Bunlar içerisinde çok sayıda çift telefon numarası mevcut.Bunları kırmızıyla işeretleyecek kod buldum ve başarılı oldu fakat mükerer kayıtları silen kodlar işe yaramadı. Mükerer kayıtları nasıl silebilirim.

 

[Necdet]

Merhaba,

Ekteki dosyada olduğu gibi B sütunundaki 0 değerlerinin dışındakiler silinebilir.

 

[1Al2Ver]

Merhaba,

Aşağıdaki linki inceler misiniz ?

http://www.excel.web.tr/forumdisplay.php?f=120

 

[osmankul]

2 ve üzeri değer verenler silinebilir diye anlıyorum çünkü 1 değeri veren satırlardan tek var.
Yalnız 2 lerin tamamını silersem mükerrerlerden geriye bir tane kalıyor mu ?

 

[Necdet]

Merhaba,

Ekteki dosyada olduğu gibi B sütunundaki 0 (Sıfır) değerlerinin dışındakiler silinebilir.

Demişim, formülü ona göre kurguladım.

 

[osmankul]

yukardaki örneklere baktım fakat bana çifte kayıtları kendiliğinden silecek bir vba kodu lağzım.İnternette bulduklarım işe yaramadı.

 

[Necdet]

Merhaba,

Sub CiftKayitSil()
    
Dim i As Long
Dim c As Range
Application.ScreenUpdating = False
Columns("A:A").Replace What:=" ", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
For i = [A65536].End(3).Row To 2 Step -1
    Set c = Range("a1:a" & i - 1).Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır...."
End Sub