mükerrer kayıtların silinmesi

[hamitcan]

Arkadaşlar herkese merhaba,
aşağıdaki gibi bir listem var. İstediğim mükerrer olanları silmesi(satır silme olabilir)

Herkese iyi çalışmalar...

A sütunu
aa
aa
aa
bb
bb
bb
bb
cc
cc
cc
dd
dd
dd

 

[ALPEN]

Private Sub CommandButton1_Click()
With Columns("A")
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("b1"), Unique:=True
.Delete Shift:=xlToLeft
End With
End Sub

mükerrer kayıt satır sil yinelenen

 

[hamitcan]

Sayın Alpen öncelikle cevabınız için teşekkürler.

makroyu çalıştırdığımda;
aa
aa
bb
cc
dd

oluyor.

Not: döngü yoluyla olmaz mıydı acaba ? Sadece merak ettiğim için soruyorum.

İyi çalışmalar.

 

[hamitcan]

Galiba ilk hücreyi başlık olarak gördüğünden yapıyor. Bilmiyorum doğru mu düşünüyorum.

 

[ALPEN]

merhaba

listenin ilk satırının başlık olduğunu düşünerek yazmıştım. örnek

İsimler
ali
ali
ali
veli
veli
veli
.
.
.
.

gibi.

bu şekilde denerseniz sorun çıkmaz.

ayrıca döngü ile
1. eğer verileriniz sıralı değil ise

For i = 1 To Cells(65536, 1).End(xlUp).Row
    For j = i + 1 To Cells(65536, 1).End(xlUp).Row
        If Cells(i, 1) = Cells(j, 1) Then
            Range(j & ":" & j).EntireRow.Delete
        End If
    Next j
Next i

2. sıralı ise

For i = 1 To Cells(65536, 1).End(xlUp).Row
    For j = i + 1 To Cells(65536, 1).End(xlUp).Row
        If Cells(i, 1) = Cells(j, 1) Then
            Range(j & ":" & j).EntireRow.Delete
        Else
            Exit For
        End If
    Next j
Next i

aslında 1. önerilen kod sıralı olsa da olmasa da çalışır. ama ikinci kod veriler sıralı ise ve çok veri varsa çok daha hızlıdır.

not : pek deneyemedim.

 

[hamitcan]

Teşekkürler gayet güzel olmuş.

İyi akşamlar....

 

[ALPEN]

denedim de, bir mantık hatası var son 2 kodda (silinen satırın yerine geçen alt satır gibi)

düzeltilmiş ve biraz daha hızlandırılmışı.

1. veriler sıralı değilse

z = Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To z
    For j = z To i + 1 Step -1
        If Cells(i, 1) = Cells(j, 1) Then
            Range(j & ":" & j).EntireRow.Delete
        End If
    Next j
Next i

2. veriler sıralı ise

z = Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
For i = 1 To z
    For j = z To i + 1 Step -1
        If Cells(i, 1) = Cells(j, 1) Then
            Range(j & ":" & j).EntireRow.Delete
        Else
            Exit For
        End If
    Next j
Next i

 

[ildizim]

ben macroyu denedim

birden fazla mükerrer kayıtta
saglıklı çalışmıyor.

düzeltebilirseniz benimde cok işime yarayacak

 

[ALPEN]

hangisini denediniz? neresi "sağlıksız" çalışıyor? hangisini düzelteyim?

 

[ildizim]

pardon sonraki kodu denemedim ilkini denemiştim. bu macroya benimde ihtiyacım vardı teşekkürler

 

[ildizim]

bir veriler sıralı değilseyi denedim... hem sıralı hemde sırasız bir dosyada aynı kayıt ikiden fazla olsa bile güzel çalışıyor çok teşekkürler...

 

[hamitcan]

Sayın Alpen ikincisini(veri sıralı ise) çalıştıramadım. Ama birincisi ve advanced filter örneği tam istediğim gibi olmuş. Bir de büyük harf - küçük harf ayrımı yapıyor. Eğer kodu geliştirmek isterseniz diye yazıyorum.

İyi Çalışmalar...

 

[jale]

Merhaba :hey:

Mükerrer:defalarca yapılan, yinelenen...(1 olursa zaten mükerrer denmez)

Sayın Alpen'in 08.Aralık.2004 17:40 da yazdığı, veriler sıralı değilse kodunu denedim gayet güzel çalışıyor.

Edit:Ben bir mesaja başlayıp yazana kadar çok zaman geçiyor galiba.Zaman aşımına uğruyor. :hiho: Lütfen bu mesajımı tamamen siliniz.
Edit xxrt:Silemem yine zaman aşımına uğradı ALPEN cevabı vermiş. :hiho:

p.s. jale: full dolu, geri iade etmek, link hattı, nüans farkı, arka fon, sinsi tuzak, giriş introsu, atlı süvari ... nasıl?

 

[ALPEN]

"Bir de büyük harf - küçük harf ayrımı yapıyor"

yapmasını istemiyorsanız.

If Cells(i, 1) = Cells(j, 1) Then

satırını

If lcase(Cells(i, 1)) = lcase(Cells(j, 1)) Then

veya

If ucase(Cells(i, 1)) = ucase(Cells(j, 1)) Then

olarak değiştirin.

p.s. jale: full dolu, geri iade etmek, link hattı, nüans farkı, arka fon, sinsi tuzak, giriş introsu, atlı süvari ... nasıl?