listeler arası karşılaştırma,(Mükerrer kayıtlar)

[Selçuk1]

Selamlar;

bu konunun forumda daha önce defalarca işlendiğini biliyorum. ve arama sonucu karşıma bir çok örnek çıktı. ancak bu örnekler benim tam olarak sıkıntımı çözmedi veya ben kendime uyarlayacak eklemeleri yapamadım. bu yüzden konuyu tekrar gündeme getirme gereği duydum.

yapmak istediğim şeylerle ilgili en yakın örnek sn.zafer bey tarafından hazırlanan aşağıdaki kodlar. bunları istediğim şekle uyarlayabilmem için yardımcı olurmusunuz?

Sub ilke_gore_Benzemeyenleri_bul()
Set s1 = Sheets("şube")
Set s2 = Sheets("mernis")
Set s3 = Sheets("fark")
s3.Range("a2:q65000").ClearContents
ason = s1.Cells(65536, 2).End(xlUp).Row
bson = s2.Cells(65536, 2).End(xlUp).Row


For a = 2 To bson + 1
b = WorksheetFunction.CountIf(s1.Range("b2:b" & ason), s2.Cells(a, 2))
If b <> 1 Then
c = c + 1
For i = 1 To 14
s3.Cells(c + 1, i) = s2.Cells(a, i)
Next
End If
Next a

End Sub
Sub mukerre1()
'ayn&#305; ozellikli say&#305;lar&#305; getirir
'[H:J].Clear
son = Application.CountA(Columns(2))

For t = 1 To son
    say = WorksheetFunction.CountIf(Columns(2), Cells(t, 2))
If say > 1 Then
    Cells(t, 2).Font.ColorIndex = 3
End If
Next
'[H:J].Sort KEY1:=[H1]
End Sub

benim isteğim ise şu;

anasayfadaki listeden TC.Kimlik No sütununa göre bir döngü başlatmak ve sırasıyla birinci satırdan başlayarak
TC.Kimlik Noyu "VERİ" sekmesindeki aynı sütunla karşılaştırmasını istiyorum. Aynı TCKN yi bulduğunda devamındaki sütunları
(yani adı, diğer adı, soyadı, baba adı, baba diğer adı sütunların&#305 karşılaştırmasını istiyorum. İkisi arasında farklılık bulduğunda ise
yani hata bulduğunda ana listenin o satırını "HATALI" sekmesinde sırasıyla yazsın. Aynı ise taramaya ikinci satırdaki TCKN'den devam etsin.
yani sırasıyla tüm TC kimlik nolarını benim veri sayfamdakilerle karşılaştıracak bulduğunda devamındaki verileri karşılaştıracak, aynı ise
taramaya devam edecek, farklı ise o satırı hatalı sayfasındaki çizelgeye işleyecek. eğer anasayfada olupta veri sayfasında olmayan kayıt bulursa onu da hatalı sayfasına işlemesi gerekiyor. zaten yukarıdaki kod bu sorunu çözüyor, ancak ilk sorunuma cevap bulamıyorum. Bu şekilde incelemem gereken binlerce satırlık 26 ayrı
çalışma kitabı var. Kısacası işinden içinden çıkamadım ve nasıl çıkacağımı da bilmiyorum.

bu sorunun çözümü olduğuna inanıyorum çünkü dün gece yabancı bir sitede buna çok benzeyen bir uygulamayı gördüm, ancak bilgisayarıma kaydetmedim. bugün bu sitede bu kodu gördüğümde farkettim aynı işe yarayabileceğini ancak iş işten geçmişti.. sabahtan bu yana arıyorum ve çıldırmak üzereyim ancak ne siteyi nede benzer uygulamayı bulamadım. ekteki örneği incelermisiniz ve biraz zamanınızı ayırıp bana yardımcı olabilirmisiniz? ayrıca aynı konuyla ilgili yeni konu açmış olmaktan dolayı verdiğim rahatsızlık için kusura bakmayın..

saygılar..

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub karsilastir()
Set s1 = Sheets("ANALİSTE")
Set s2 = Sheets("VERİ")
Set s3 = Sheets("HATALI")
s3.[a3:g65536].ClearContents
For a = 2 To s1.[a65536].End(3).Row
say = WorksheetFunction.CountIf(s2.[a:a], s1.Cells(a, "a"))
If say > 0 Then
sat = s2.[a1:a65536].Find(s1.Cells(a, "a")).Row
For b = 2 To 6
If s1.Cells(a, b) <> s2.Cells(sat, b) Then
sonsat = s3.[b65536].End(3).Row + 1
s3.Cells(sonsat, "a") = sonsat - 2
s3.Range("b" & sonsat & ":g" & sonsat) = s2.Range("a" & sat & ":f" & sat).Value
GoTo 10
End If
Next
End If
10 Next
MsgBox "işlem tamamlandı."
End Sub

 

[Selçuk1]

sn. levent bey;

gerçekten ne diyeceğimi bilemiyorum. tek kelimeyle muhteşem.. size nasıl teşekkür etsem azdır valla.. yaklaşık 40bin satırlık veriyi bu şekilde tek tek karşılaştırmam gerekiyordu. günlerce hatta haftalarca sürecek bir işlemden kurtardınız beni...

ancak küçük bir sorum daha olacak. sn.zafer beyin yukarıda yazdığım komutları için de ayrı ayrı butonlar koydum sayfa üzerine. ve ikinci makro çalıştığında (ilke_göre_benzemeyenleri_bul) sonuçları "hatalı2" diye oluşturduğum sayfaya yazmasını istiyorum. kod çalışıyor ancak hepsini bulamıyor. sanırım kodları doğru uyarlayamadım. ve nerede hata yaptığımı göremiyorum. lütfen ilgilenir misiniz?
(hazırlamaya çalıştığım dosya ekte)

saygılar...

 

[Selçuk1]

kodlar mükemmel çalışıyor, ancak küçük bir sorum var?

sayın leventm ve tüm saygıdeğer üstadlarım;

yukarıdaki sorumu (3ncü mesaj) unutun.. :mrgreen: :mrgreen: o problemi çözdüm, yani sorun tamamen benden kaynaklanıyormuş. :hihoho: :hihoho:
iki gündür sn.leventm tarafından hazırlanan kodları esas belgelerime uyarlamakla meşgulum. eğer bir yerlerde yanlışlık yapmıyorsam kodların çalışma mantığını büyük ölçüde anladım ve kodlar kusursuz çalışıyor.ancak şöyle bir sorum olacak;

yukarıda yazdığım sn.zafer tarafından hazırlanan kodlara küçük bir ilave yapmak istiyorum. ilke_göre_benzemeyenleri_bul makrosu çalıştığında s1 de olupta s2 de olmayan verileri buluyor ve tüm satırı s3'e yazıyor. işte bu noktada yani s3 e yazdıktan sonra bu verileri s1 den silsin istiyorum. (mümkünse tüm satır olarak).. bununla ilgili nasıl bir ilave yapabiliriz..

bu sorunu nasıl çözebiliriz, değerli fikirlerinizi bekliyorum??

 

[Selçuk1]

fikri olan var mı?

sayın üstadlarım;
Sn.Zafer Bey'e ait kodlar aşağıdadır. s2'de olup, s1'de olmayan kayıtları bulup s3'e kaydediyor aşağıdaki kodlar.. buna ilaveten bu bulduğu kayıtları s2'den silmesini (tüm satırı) nasıl sağlayabiliriz? buna çok acil ihtiyacım var, hala işyerindeyim ve mesai yapıyorum.. değerli fikirlerinizi bekliyorum...

Sub ilke_gore_Benzemeyenleri_bul()
Set s1 = Sheets("şube")
Set s2 = Sheets("mernis")
Set s3 = Sheets("fark")
s3.Range("a2:q65000").ClearContents
ason = s1.Cells(65536, 2).End(xlUp).Row
bson = s2.Cells(65536, 2).End(xlUp).Row
For a = 2 To bson + 1
b = WorksheetFunction.CountIf(s1.Range("b2:b" & ason), s2.Cells(a, 2))
If b <> 1 Then
c = c + 1
For i = 1 To 14
s3.Cells(c + 1, i) = s2.Cells(a, i)
Next
End If
Next a
End Sub

 

[Levent Menteşoğlu]

Kod içine aşağıdaki kırmızı renkli satırı ilave ederek deneyin.

[LEFT]Sub ilke_gore_Benzemeyenleri_bul()
Set s1 = Sheets("şube")
Set s2 = Sheets("mernis")
Set s3 = Sheets("fark")
s3.Range("a2:q65000").ClearContents
ason = s1.Cells(65536, 2).End(xlUp).Row
bson = s2.Cells(65536, 2).End(xlUp).Row
[COLOR=red][B]For a = bson + 1 to 2 step -1
[/B][/COLOR]b = WorksheetFunction.CountIf(s1.Range("b2:b" & ason), s2.Cells(a, 2))
If b <> 1 Then
c = c + 1
For i = 1 To 14
s3.Cells(c + 1, i) = s2.Cells(a, i)
Next
[COLOR=red][B]s2.rows(a).delete[/B][/COLOR]
End If
Next a
End Sub[/LEFT]

 

[Selçuk1]

Sayın Leventm üstadım,

akşamdam bu yana kodları deniyorum ve bilgileri kontrol ediyorum. bu yüzden size geri dönüş yapamadım. çok çok teşekkürler.. kodların hepsi mükemmel ve sorunsuz çalışıyor.. "sıfır hata".. gerçekten harika.. elinize emeğinize sağlık.. bu arada sayın zafer beye de teşekkürler.. elleriniz dert görmesin sayın üstadlar...

saygılar...

:hihoho: :hihoho: :hihoho:

 

[yenmez1970]

Hatalıların renklerini değiştirmek

Yukarıdaki örneği inceledim fakat ben kod yazma olayına yabancıyım. Eğer Bu kodların karşısına ' işareti ile ne anlatmak istediğini de yazarsanız sevinirim. En azından örneğe bakınca ne demek istediğini anlamaya çalışırım. O kodda bulunan Row ne manaya geliyor? diğerleride bilemiyorum. Ama Yaptığım iş gereği bunlar banada çok lazım oluyor. Çalıştığım yerde genellikle excel kullanmak zorundayız. İlgilenenlere Teşekkür ediyorum.