Aynı İki Rakamın İkisinide Hücreden sildirmek

[soneroo]

Merhabar ;

Excell üzerinde içinden çıkamadığım bir durum var e sütünumda yaklaşık 10000 satırlık seri numaraları var bunlar içerisinde mükerrer olanlarda mevcut ben bu mükerrer olanların hepsini sildirmek istiyorum yardımcı olabilirmisiniz teşekkürler

örnek olarak 1151386 numarasından 2 tane var ben ikisinide sildirmek istiyorum.

kullandığım excell sürümüm 2003

 

[Murat OSMA]

Veri menüsündeki Gelişmiş filtre'den benzersiz kayıtları listele diyebilirsiniz...

 

[soneroo]

Murat bey teşekkür ederim fakat o benim işimi görmüyor mesela E12 deki veriyle E5789 daki veri aynı ben bunların ikisinide silmek istiyorum

 

[tahsinanarat]

Sub Düğme1_Tıklat()
basla:
On Error Resume Next
For i = 1 To 10000
bul = [A1:A10000].Find(Range("A" & i)).Row
ara = [A1:A10000].Find(Range("A" & i))
adet = WorksheetFunction.CountIf([A1:A10000], Range("A" & i))
If adet > 1 Then
Rows(bul).Delete
For x = 1 To adet - 1
bul2 = [A1:A10000].Find(ara).Row
Rows(bul2).Delete
Next x
GoTo basla
End If
Next
MsgBox "Bitti"
End Sub

 

[Merhum İdris SERDAR]

.

Veriler A sütununda yer aldığını varsayarsak;

B1'e

=COUNTIF($A$1:$A$10000;A1)

yazıp aşağıya doğru kopyalayın.

2 ve daha büyük için süzme yapın.


Sonra satırları silin.

.
.

 

[Murat OSMA]

Haklısınız...

Sn. tahsinanarat,yanıt vermiş. İyi günler...

 

[soneroo]

Verdiğiniz bilgiler için teşekkürler deneme fırsatım olmadi kısa zamanda.deniyecem tekrar tesekkurler

 

[asi_kral]

Merhabar ;

Excell üzerinde içinden çıkamadığım bir durum var e sütünumda yaklaşık 10000 satırlık seri numaraları var bunlar içerisinde mükerrer olanlarda mevcut ben bu mükerrer olanların hepsini sildirmek istiyorum yardımcı olabilirmisiniz teşekkürler

örnek olarak 1151386 numarasından 2 tane var ben ikisinide sildirmek istiyorum.

kullandığım excell sürümüm 2003

Merhaba
Alternatif Olsun

Option Explicit
Sub Mükerrer_Olanları_Sil_1967()
'Konu       :   Mükerrer Kayıtları Sil
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Long, kral As New Collection, a As Range
Dim b As Range, c
On Error Resume Next
For asi = 1 To Cells(Rows.Count, "E").End(xlUp).Row
If WorksheetFunction.CountIf(Range("E:E"), Cells(asi, "E")) > 1 Then
kral.Add Cells(asi, "E"), CStr(Cells(asi, "E"))
End If: Next
For Each a In kral
Set b = Range("E:E").Find(a, , , xlWhole)
If Not b Is Nothing Then
c = b.Address
Do
Cells(b.Row, "E").ClearContents
Set b = Range("E:E").FindNext(b)
Loop While Not b Is Nothing And b.Address <> c
End If
Next
Range("E:E").Sort key1:=Range("E1"), order1:=xlAscending
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

 

[soneroo]

arakadaşlar herkese çok çok teşekkürler denedim çok güzel çalışıyor emeklerinize sağlık

 

[asi_kral]

arakadaşlar herkese çok çok teşekkürler denedim çok güzel çalışıyor emeklerinize sağlık

Kolay Gelsin.