Birden fazla sütuna göre ayıklama

[zicomkaan]

Ustalık sorusu, birden fazla sütuna göre ayıklama

Merhaba arkadaşlar ben bir olayı bir türlü başaramadım . Makro yazmaya çalışıyorum ama olmuyor . Örneğin ;

B,C,D,E,F,G,H,K,L,M,N ... sütunlarında 50.000 er adet toplam 1 milyon farklı numara var . Hiç bir numara aynı değil . A sütununda numara yok ( boş ) ama ben buraya 50,000 farklı numara yapıştırdığımda B,C,D,E,F,G,H,K,L,M sütunlarında aynıları varsa bana uyarı verecek ve diyecek ki " bu numaralardan atıyorum 105 aynı numara var silinsin mi" diyecek evet dediğimde sadece yeni yapıştırdığım A sütunundan silecek ve benzer olmayanlar A sütununda kalacak diğer sütunlardaki benzerlerine karışmayacak.

Buna benzer bir makro buldum ancak bu sadece A sütununda numaralar varken altına yapıştırdığında yukarıda benzer olanları siliyor. b,c,d,e,f,g yı önemsemiyor doğal olarak .

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
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

Örnek dosya ektedir ...

Şimdiden çok ama çok teşekkürler ...

 

[Murat OSMA]

Bu tesadüf mü acaba ? :dusun:

http://www.excel.web.tr/f48/ayny-olan-numaralary-kaldyrma-makrosu-t133780.html

Bu aralar sıklaşmaya başladı bu durum, hadi bakalım hayırlısı...

 

[zicomkaan]

Arkadaşla bir alakam yok cidden Tamamen tesadüf . Çalıştığım işyerinden ( Call Center ) istediler . Yapamazsam muhtemelen işimden olucam Sabah beri araştırıyorum şu verdiğim makroyu tek sütunda değil de birden çok sütunda yapabilirsem olay tamamdır.

 

[zicomkaan]

Bu arada örnek dosyayı ekledim teşekkürler ...

 

[Murat OSMA]

Call Centerları hiç sevmem.

İlgilenecek arkadaş olacaktır. İyi akşamlar.

 

[zicomkaan]

bende hıc sevmıyorum ama ekmek parası Tesekkurler ılgıne dostum

 

[zicomkaan]

Gece saat 3 oldu ve ben hala bununla ugrasiyorum :s Cidden isimden olabilirim. Yok mu bir üstad bunu yapabilecek ? Kolayina kaçmaktan degil gerçekten yardima ihtiyacim oldugu için sordum ... ( turkce katliyami icin özür dilerim. Telden yazıyorum )

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim X As Long, Say As Long, Onay As Byte
    
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If WorksheetFunction.CountIf(Range("B:H"), Cells(X, 1)) > 0 Then
            Say = Say + 1
        End If
    Next
    
    If Say > 0 Then
        Onay = MsgBox(Say & " Adet aynı numara tesbit edildi! Silinsi mi?", vbCritical + vbYesNo)
        If Onay = vbNo Then Exit Sub
        For X = 1 To Cells(Rows.Count, 1).End(3).Row
            If WorksheetFunction.CountIf(Range("B:H"), Cells(X, 1)) > 0 Then
                Range("A:A").Replace Cells(X, 1), "", xlWhole
            End If
        Next
        Range("A:A").Sort Range("A1")
    End If
End Sub

 

[zicomkaan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim X As Long, Say As Long, Onay As Byte
    
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If WorksheetFunction.CountIf(Range("B:H"), Cells(X, 1)) > 0 Then
            Say = Say + 1
        End If
    Next
    
    If Say > 0 Then
        Onay = MsgBox(Say & " Adet aynı numara tesbit edildi! Silinsi mi?", vbCritical + vbYesNo)
        If Onay = vbNo Then Exit Sub
        For X = 1 To Cells(Rows.Count, 1).End(3).Row
            If WorksheetFunction.CountIf(Range("B:H"), Cells(X, 1)) > 0 Then
                Range("A:A").Replace Cells(X, 1), "", xlWhole
            End If
        Next
        Range("A:A").Sort Range("A1")
    End If
End Sub

Bunu denedim ama herhangi bir değişme olmadı korhan bey. Siz denediniz mi gönderdiğim örnekte ? Birde 2003 türkçe excel olmasından kaynaklı oluyor olabilir mi diyeceğim ama sanmıyorum. olmazsa benim yaptığım dosyada yapılmış olarak buraya atmanız mümkün mü ?

Uyarı vermeyip silinsin mi demesine de gerek yok aslında. Daha kolay olacaksa sadece a sütununa yapıştırdığım 50.000 yeni numarayı b.c.d.e.f.g.h.k.l.m.n. .... sütunlarındaki 50.000 er satırlık eski numaralarda arasın aynısı olan varsa a sütunundan yani yeni yapıştırdığımdan benzer olanını silsin diğer sütunlardaki ( b.c.d.e.f.g.h.k.l.m.n. .... ) benzerleri kalsın.

 

[Korhan Ayhan]

Aslında uyarı işlemi işi yavaşlatıyor. Siz istediğiniz için ekledim.

Ekteki dosyada uyarı işlemini kaldırdım. Satır sayısı fazla olduğu için işlem uzun sürebilir. Koda bazı eklemeler yaptım. Tekrar deneyiniz.

Uygulanan kod;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim X As Long, Sutun As String, Satir As Long, Alan As String, Bul As Range
    
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If WorksheetFunction.CountA(Range("A:A")) = 0 Then Exit Sub
    If Application.CutCopyMode = xlCopy Then Exit Sub
    If Application.CutCopyMode = xlCut Then Exit Sub
    
    Sutun = "AZ"
    Satir = 50000
    Alan = "B1:" & Sutun & Satir
    
    Application.ScreenUpdating = False
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        Set Bul = Range(Alan).Find(Cells(X, 1), , , xlWhole)
        If Not Bul Is Nothing Then
            Range("A:A").Replace Cells(X, 1), "", xlWhole
        End If
    Next
    
    Range("A:A").Sort Range("A1")
    
    Application.ScreenUpdating = True
    
    MsgBox "Listedeki mükerrer numaralar temizlenmiştir.", vbInformation
End Sub

 

[zicomkaan]

Eyvallah kardeşim . Çalışıyor ama yaklaşık 1 saat 20 dakika oldu 730.000 veri içinden 50.000 veriyi tarama yapıyor hala bitiremedi . Bu da çok çok çok uzun bir zaman demek. Bunu hergün defalarca kullanacağımı düşünürsek eyvah eyvah Var mıdır bunun daha hızlı bir yolu ? Yani olay şu ; 1 milyon telefon numarasında 50.000 er halinde yeni numaraları arama yaparak mükerrer olanları yeni eklediğin 50.000 in içinden silecek. Tabi süre de mümkün olduğunca kısa olacak . :S çok şey istedim biliyorum ama napim Başarmak için önce istemek lazım ...

 

[Korhan Ayhan]

Merhaba,

Üstteki dosyayı güncelledim. Tekrar dener misiniz? Şimdiki kodlamada örnek dosyada işlem saniye bile sürmüyor. Çok veri olunca işlem süresi ne kadar sürer bilemiyorum. Deneyip sonucu bildirir misiniz?