• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Mükerrer kayıt sorusu?

  • Konbuyu başlatan Konbuyu başlatan nintro
  • Başlangıç tarihi Başlangıç tarihi
Katılım
25 Kasım 2005
Mesajlar
27
18 bin telefon numarası var. Mükerrer olan 2 telefon kaydınında satırlarının silinmesini istiyorum nasıl bir kod ile yapabilirim.

(Aynı 2 kayıt var ise iki satırda silinecek. )
 
direk bir yolu varmi bilmiyorum ama conditional formatingle bir tane olanlari renklendirebilirsiniz,

daha sonra renkli olanlardaki ortak biseyi suzde containsle ayirmak icin replace yapabilir ve tek olanlari suzmus olabilirsiniz..
 
Mükerer olmayanların ortak bir noktası yok. Yada A hücresindeki numaralardan mükerrer olanlarının d hücresinde karşılarına 1 yazarsa süzme yöntemi ile yine kolayca silenebilir mükerrer olanlar.

A hücresinde tel no
B hücresinde ad
c hücresinde soyad var o yüzden d hücresi yazdım
 
siz dosyanizi ekleyin biz cozum uretmeye calisalim olmaz mi yada ornek bir dosya yaparsaniz..
 
Dosyanız ektedir.:cool:
Kod:
Sub liste()
Dim sat As Long, i As Long, a As Long, list()
Sheets("Sayfa1").Select
sat = Cells(65536, "A").End(xlUp).Row
ReDim list(1 To 3, 1 To sat)
For i = 1 To sat
    If WorksheetFunction.CountIf(Range("A1:A" & sat), Cells(i, "A").Value) = 1 Then
        a = a + 1
        list(1, a) = Cells(i, "A").Value
        list(2, a) = Cells(i, "B").Value
        list(3, a) = Cells(i, "C").Value
    End If
Next i
If a > 0 Then
    Application.ScreenUpdating = False
    Range("A1:C65536").ClearContents
    ReDim Preserve list(1 To 3, 1 To a)
    Range("A1").Resize(UBound(list, 2), 3) = Application.Transpose(list)
    Application.ScreenUpdating = True
    MsgBox "Benzersiz kayıtlar Çıkarılmıştır." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
End Sub
 

Ekli dosyalar

Geri
Üst