Mükerrer kayıtların işaretlenmesi

[penguen yavrusu]

Herkese merhabalar;
Bir makro düzenledim ya da öyle sandım. Bu makro x@x.com vb adreslerin aynılarını kırmızı olarak işaretlemeli. Ama bendeki işaretlemiyor.Yani alt alta aynı isimden 1000 tane yazdım hani birinde tutar diye onu bile beceremedim . Bu konuda bana hazır makro varsa yada örnek bir excel çalışması varsa söyleyebilirmisiniz benim yaptığım ekte, kontrol ederseniz sevinirim.

 

[Kemal Demir]

Sub kırmızı()
For x = 1 To 30
If Cells(x, 1).Value = Cells(x + 1, 1).Value Then
Cells(x + 1, 1).Interior.ColorIndex = 3
'c1 hucresindede tekrar sayısı yazacaktır.
[c1].Value = [c1] * 1 + 1
End If
Next

End Sub


Amaç Kırmızıları ve tekrar sayısını bulmakise bu kod işinizi görecektir.

 

[penguen yavrusu]

Çok teşekkür ederim ama buda istediğim şekilde bir işlem yapamadı. Benim istediğimi anladığınızı çok iyi biliyorum ama yapılacak işlem şu x@x, x@x bu ikinci olanı işaretlemesi. Yazdığım makro üstündende hareketle nasıl bir değişiklik yapacağım sizin söylediğiniz aynen uyguladım ama çalışmadı. bunu çözebilirsem yaklaşık 10000 küsür maili düzenliyeceğim, ama düzenliyemiyorum.

 

[zafer]

Merhaba

Dosyayı inceleyiniz.








Edit:Başlığınız konunuza uygun olmadığı için değiştirdim.

 

[Kemal Demir]

Sn.Penguen Yavrusu

Gondermiş Oldugum kod Çift(Mükerrer) olanları kırmızıya boyuyor.

Ama Çok Gizli Bir Çalışma Değil ise Küçük Bir Örnek Dosya Yollarsanız daha anlatıcı olacagına ınanıyorum.

 

[zafer]

Merhaba

yapılacak işlem şu x@x, x@x bu ikinci olanı işaretlemesi.

Sayın Kemal beyin kodlarını incelememiştim.İsteğinize göre oda aynı işlemi yapıyor.

 

[mehmett]

Arkadaşlar güzel çözümler üretmişler ama sanırım sorunuzu tam anlamamışlar. Ben de yanlış anlamadıysam Sn Zafer'in yazdığı kodlarda sadece bir değişiklik ile istediğiniz çözüme ulaşacaksınız. Aşağıda kırmızı renkle belirttiğim değişikliği yapın. (Zafer'in kodlarında 2 olan rakam 1 olacak.)

Sub listele2()
For b = 1 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("a1:a" & b), Cells(b, 1)) <> 1 Then
Cells(b, 1).Interior.ColorIndex = 3
End If
Next
End Sub

 

[zafer]

Merhaba

yapılacak işlem şu x@x, x@x bu ikinci olanı işaretlemesi.

Sayın Mehmet teşekkür ederim.

Yalnız ikinci mükerrer kayıtlar isteniyor.
Sayın Kemal bey ve benimki(belittiğiniz gibi 1 sütun olacak) aynı işlemi görüyor.
eklenen dosyanın A sütununda gösterilen biçime göre aynı işlemi yapıyor.
Fakat Bu işlemde istenen sonucu vermedi diye mesaj geliyor.

 

[Kemal Demir]

Kabalıgımı bağışlayın arkadaslar ama,Penguen Yavrusu arkadasımız tam olarak ne istediğini belirtememiş diye dusunuyorum.

Aslına bakarsanız daha detaylı küçük bir örnek dosya ile çözüm daha kısa zamanda halledilmiş olur.

İyi Çalışmalar.

 

[zafer]

Hayır Kemal bey...

İkimizde çok iyi anladık verdiğimiz cevaplarda doğru...Fakat siz örnek dosyaya göre yaptığınız için 30 değişken tanımlamışsınız.
Bende A sütunu yerine mükerrer olanları B sütununda işaretletmişim

30 hücreye kadar yapıyor veya B sütunundaki hücreleri işaretleniyor deneceği yerde İstediğime uygun değil diye mesaj dönülüyor.

 

[Kemal Demir]

Zafer Bey Teşekkur Ederim.

Bu arada kodda sole bir ilave etsem hukalalık olmaz umarım.

Sub kırmızı()
For x = 1 To Cells(65536, 1).End(xlUp).Row
If Cells(x, 1).Value = Cells(x + 1, 1).Value Then
Cells(x + 1, 1).Interior.ColorIndex = 3
'c1 hucresindede tekrar sayısı yazacaktır.
[c1].Value = [c1] * 1 + 1
'B kolonuna tekrar kayıtların yanına tekrar yazdırıyor
Cells(x + 1, 2).Value = "Tekrar"
End If
Next
End Sub

 

[zafer]

Merhaba

Ne demek her zaman alternatif çözümler gönderebilirsiniz.Veilmiş cevabın üzerine cavap gönderilemez diye bir kural yok..Kaldıki ilk cevap gönderende sizsiniz.

iyi çalışmalar.

 

[penguen yavrusu]

Öncelikle yardımlarınız ve çabalarınız için çok teşekkür ederim. Yapmak istediğim çalışma ile ilgili hazırladığım Dosyayı ekte gönderiyorum. Bu çalışma bir mailing sent list olarak düşünebilirsiniz. Elimizde var olan maillerideki aynı adresleri silmek için kullanacağım ama bende ki liste çalışmıyor, nerede yanlış yaptığımı bildirirseniz ve gerekli kodu yazarsanız çok sevinirim. İyi çalışmalar dilerim.

 

[Kemal Demir]

penguen yavrusu

Dosyayı İnceleyiniz.

Bu konu Hk. bu soru için cevap veren mehmet ve Zafer Bey'lerin Açıklamalarıda Gayet anlasılır diye dusnuyorum.

Umarım EK'teki dosya işinizi görecektir.

 

[Kemal Demir]

Dosyayı Eklememişim.

 

[penguen yavrusu]

Kemal bey merhabalar;
Kesinlikle Mehmet ve Zafer beylerin yapmış oldukları çalışmaları ve sizlerin buradaki fikir alışverişinin ne kadar güzel olduğunu fark ettim ve bu grup sayesinde Excel olan ilgim giderek artmaya başladı . Sizden son bir ricam daha olabilirmi ? Bu işaretlenen satırları otomatik olarak nasıl temizliyebilirim peki ?

 

[mehmett]

B sütununda "Tekrar" yazan satırları silen kod;

Sub Makro1()
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.EntireRow.Delete
Range("A1").Select
End Sub

 

[Ali]

A sütununuzdaki benzer kodları silmek için ise


Sub tekrarısil()
For a = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then Rows(a).Delete
Next
End Sub

 

[Kemal Demir]

Üstadlar Gereken ilgiyi(cevabı) göstermişler.

Bende yazmak istedim(Mehmet,Fructose) affınıza sıgınarak,

Sub sil()
For x = Cells(65536, 1).End(xlUp).Row To 1 Step -1
If Cells(x, 1).Value = Cells(x + 1, 1).Value Then
Rows(x).Delete
End If
Next

End Sub

 

[penguen yavrusu]

Ellerinize sa&#287;l&#305;k, te&#351;ekk&#252;r ederim. &#199;ok sa&#287;olun da &#351;&#246;yle bir sorunum var benim halen devam etmekte olan. x@x.com &#231;iftini yakal&#305;yor, temizle dedi&#287;imde x@x.com k&#305;rm&#305;z&#305; rengini kald&#305;r&#305;yor, sat&#305;r&#305; tamamen temizlemiyor. Benim istedi&#287;im x@x.com sat&#305;r&#305;n&#305; tamamen temizlemek.