mükerrer olan bulup silme

[subutayı]

merhaba,
arkadaşlar görderdiğim örnek listede D sütünunda 7227 satıra kadar TC kimlik nolar yazılı. aynı TC Kimlik nodan bir veya birkaç tane yazılmış. benim yapmak istediğim. aynı TC no dan kaç tane olursa olsun sadece biri kalsın. diğerlerini silmek istiyorum. ilginiz için teşekürler.

 

[Muhammet Okumuş]

Merhaba. Aslında bu konuyla ilgili bir çok çalışma var. Kodu uygulayınız.

Sub Sil()
Application.ScreenUpdating = False
For i = 7227 To 6 Step -1
say = WorksheetFunction.CountIf(Range("D7227" & i), Cells(i, 4))
If say > 1 Then Rows(i).Delete
Next
End Sub

 

[sadikk_]

Merhaba ,

Duplicate kayıtları silmek için ilgili sutunu tamamen seçip Home kısmından remove duplicate kısmından aynı kayıtları silebilirsin..

 

[subutayı]

muhammet bey,
ilginize teşekür ederim. silmeden mükerrer kayıtların satırlarını renklendirebilir miyiz. yukarıdaki kodun açıklamasını yaparsanız çok memnun olurum. konu ile ilgili çok açıklama var ama acemiyim. kodları analiz edemiyorum ve yazamıyorum.

 

[subutayı]

sadık bey office 2003 kullanıyorum. sizin yönteminiz 2003 de var mı

 

[Muhammet Okumuş]

Sub Renk()
Application.ScreenUpdating = False
For i = 7227 To 6 Step -1
say = WorksheetFunction.CountIf(Range("D67227"), Cells(i, 4))
If say > 1 Then Range("A" & i & ":K" & i).Interior.ColorIndex = 6
Next
End Sub

say ile mükerrer olanları belirliyoruz. Yani D sütunundaki i değişkenine denk gelen değer 1 den fazla ise A:K satırını(i değeri) sarıya boya diyoruz.

 

[subutayı]

teşekürler,
iyiki varsınız.

 

[subutayı]

arkadaşlar,
işin boyutu değişti. Aynı olan TC kimlikli mükerer kayıtları bularak G ve K alanları toplamları alınıp tek olanın üzerine ilave edildikten sonra silinmesi gerekiyor.

 

[Muhammet Okumuş]

Bir tane dosya ekleyiniz. Veri olacak şekilde.

 

[subutayı]

yeni dosya

muhammet bey,
ekli yeni dosya

 

[Muhammet Okumuş]

Dosyayı inceleyiniz. Data ve Bul sayfası olarak iki sayfa var. Data sayfasına bilgilerinizi yazıyorsunuz. Bul sayfası ise mükerrer olanlar silinmiş ve hesap yapılmış olan sayfadır. Dosya mükerrer kayıtları en alttaki mükerrer kalacak şekilde siliyor.

Sub Hesapla()
Dim son, i, say As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Bul").Delete
ActiveSheet.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Bul"
son = Range("D30000").End(3).Row
For i = son To 6 Step -1
say = WorksheetFunction.CountIf(Range("D" & son & "" & i), Cells(i, 4))
If say > 1 Then Rows(i).Delete
Next
son = Range("D30000").End(3).Row
Range("G6:G" & son) = "=SUMPRODUCT(--(Data!D$6$30000=D6),(Data!G$6:G$30000))"
Range("K6:K" & son) = "=SUMPRODUCT(--(Data!D$6$30000=D6),(Data!K$6:K$30000))"
Range("G6:K" & son) = Range("G6:K" & son).Value
ActiveSheet.DrawingObjects.Delete
End Sub

 

[subutayı]

sayın öğretmenim, Muhammet Bey,
ilginize çok teşekkür ederim. istediğim olmuş. başarılarınızın devamını dilerim. bu bir programa eklenecek inşallah sorun çıkmaz. bul daki verileri copy yaparak yeni bir excel e yapıştırdım. data olmadan bir sorun çıkmaz inşallah. başka bir excel sayfasına yapıştırınca sütün genişlikleri bozuluyor. bire bir başka bir excel sayfasına nasıl yapıştırılır.

 

[Muhammet Okumuş]

Sorun çıkmaz. Tabi dosyanız bu şekilde ise. Data ve Bul Sayfa adlarını Modül'de yer alan kodları değiştirerek yapabilirsiniz.