• DİKKAT

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

mükerrer satırların silinmesi

  • Konbuyu başlatan Konbuyu başlatan tar23
  • Başlangıç tarihi Başlangıç tarihi
Katılım
29 Eylül 2006
Mesajlar
109
Excel Vers. ve Dili
2007 türkçe
arkadaşlar birdosyam var buradaki mükerrer satırların silinmesini sadece bir tanesinin kalması mümkünmüdür. yardımlarınızı bekliyorum
 

Ekli dosyalar

Veri Menüsündeki Gelişmiş Filtre'den benzersiz kayıtları deneyiniz...
 
Forumda aradığınızda çok örneği var.
Kod:
Option Explicit
 
Sub MÜKERRERLERİ_SİL()
    Dim X As Integer
    
    If MsgBox("Mükerrer kayıtlar silinecektir işlemi onaylıyor musunuz?", vbCritical + vbYesNo, "Dikkat") = vbNo Then Exit Sub
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    For X = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        If WorksheetFunction.CountIf(Range("A1:A" & X - 1), Cells(X, 1)) > 0 Then
            Rows(X).Delete
        End If
    Next
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sub mukerrersil()
Dim i, y, a As Integer
a = WorksheetFunction.CountA(Range("b1:b65000"))
For i = 1 To a
For y = i + 1 To a
If Cells(i, 1).Value = Cells(y, 1) Then
Cells(i, 1).Value = Cells(i, 1).Value
Cells(y, 1).Value = Cells(y, 1).Value
Cells(y, 1).EntireRow.Delete
End If
Next y
Next i
End Sub
 
arkadaşlar her ikiside işe yaradı
zaman ayırdığınız işin teşekkür ederim
 
Geri
Üst