Soru 2 Hücreyi Karşılaştırıp Aynı Olan Hücreleri Silme

[iavdan06]

J SUTUNUNDA YAZAN SAYILARI A VE B HÜCRELERİNDE KONTROL ETTİRİP İÇERİSİNDE AYNI SAYILAR GEÇEN HÜCRELERİ OTOMATİK OLARAK SİLMEK İSTİYORUM ŞÖYLE BİR SORUNUM DAHA VAR MESELA J15 104159 YAZIYOR BU BİLGİLERİ DAHA ÖNCE GİREN ARKADAŞ A VE B SÜTUNUNA GİRERKEN SAYILARIN BAŞINA 0 VE 00 EKLEMİŞ YANİ A VE B SÜTUNUNDA ARADIĞIM SAYI 00104159 VEYA 0104159 OLABİLİR ELİMDE BU ŞEKİLDE 36589 TANE KAYIT VAR BUNU NASIL YAPABİLİRİM YARDIMLARINIZ İÇİN ŞİMDİDEN TEŞEKKÜR EDERİM
Örnek dosya burda

 

[Korhan Ayhan]

Hatırlatma Forum Kuralları;

Büyük Harf Kısıtlaması:
- Mesaj yazarken büyük harf kullanmak bağırmak anlamına geleceği için yazılarınızı kesinlikle büyük harf kullanarak yazmayınız.

 

[iavdan06]

Hatırlatma Forum Kuralları;

kusura bakmayın capslock açık kalmış farkında değilim ayrıca büyük harf kullanımının yasak oldugunuda bilmiyordum

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodu sayfanın kod kısmına kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Long
    Dim Bul As Range
    For Bak = Cells(Rows.Count, "J").End(xlUp).Row To 1 Step -1
        Set Bul = Range("A" & Bak & ":B" & Bak).Find(what:=Cells(Bak, "J"))
        If Not Bul Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

Bu arada eklediğiniz örnek dosyada aynı sayılar geçen hiçbir satır yok. Yani hiçbir satır zaten silinmesi gerekmiyor.

 

[iavdan06]

Merhaba.

Aşağıdaki kodu sayfanın kod kısmına kopyalayıp çalıştırın.

Sub Test()
    Dim Bak As Long
    Dim Bul As Range
    For Bak = Cells(Rows.Count, "J").End(xlUp).Row To 1 Step -1
        Set Bul = Range("A" & Bak & ":B" & Bak).Find(what:=Cells(Bak, "J"))
        If Not Bul Is Nothing Then
            Rows(Bak).Delete
        End If
    Next
End Sub

Bu arada eklediğiniz örnek dosyada aynı sayılar geçen hiçbir satır yok. Yani hiçbir satır zaten silinmesi gerekmiyor.

ilginiz için teşekkür ederim yalnız yapamadım ben yani aynı kaytılar hala duruyor aşşağıdaki linkteki videoyu bir seyredebilirmisiniz aldığım hatayı video olarak kaydettim

bandicam 2020-09-14 13-59-53-859

Watch "bandicam 2020-09-14 13-59-53-859" on Streamable.

streamable.com

 

[Muzaffer Ali]

Çalıştığınız dosyanın uzantısı "xlsx" bu uzantıyı taşıyan dosyaları kayıt etmek istediğinizde uyarı verir çünkü kodlar kaydedilmez.
Zaten uyarıda bu durum açıkça belirtiliyor.

Siz orada "Hayır" ı seçin ve dosyanızı "xlsm" uzantısı ile farklı kaydedin. Bu durumda kodlar kayıt edilir.

 

[iavdan06]

Çalıştığınız dosyanın uzantısı "xlsx" bu uzantıyı taşıyan dosyaları kayıt etmek istediğinizde uyarı verir çünkü kodlar kaydedilmez.
Zaten uyarıda bu durum açıkça belirtiliyor.

Siz orada "Hayır" ı seçin ve dosyanızı "xlsm" uzantısı ile farklı kaydedin. Bu durumda kodlar kayıt edilir.

sağolun evet makroyu çalıştırdım yalnız silme işlemi yapmıyor tekrar ekran kaydı aldım izleyebilirmisiniz

bandicam 2020-09-14 14-32-01-076

Watch "bandicam 2020-09-14 14-32-01-076" on Streamable.

streamable.com

 

[Muzaffer Ali]

Aşağıdaki kodu dener misiniz?

Sub Test()
    Dim Bak As Long
    Dim Bul As Range
    For Bak = Cells(Rows.Count, "J").End(xlUp).Row To 1 Step -1
        Set Bul = Range("A:B").Find(what:=Cells(Bak, "J"), lookat:=xlPart)
        If Not Bul Is Nothing Then
            Rows(Bul.Row).Delete
        End If
    Next
End Sub

 

[iavdan06]

Aşağıdaki kodu dener misiniz?

Sub Test()
    Dim Bak As Long
    Dim Bul As Range
    For Bak = Cells(Rows.Count, "J").End(xlUp).Row To 1 Step -1
        Set Bul = Range("A:B").Find(what:=Cells(Bak, "J"), lookat:=xlPart)
        If Not Bul Is Nothing Then
            Rows(Bak).Delete
            Rows(Bul.Row).Delete
        End If
    Next
End Sub

oldu ellerinize sağlık yalnız j sütunundanda siliyor j sütunundan silmeyecek şekilde düzenleyebilirmisiniz

 

[Muzaffer Ali]

En son yazdığım kodu düzelttim yeniden deneyin.

 

[maliex]

Üstadım bu şekilde olması gerekmezmi, yoksa her türlü j den silicek

Sub Test()
    Dim Bak As Long
    Dim Bul As Range
    For Bak = Cells(Rows.Count, "J").End(xlUp).Row To 1 Step -1
        Set Bul = Range("A:B").Find(what:=Cells(Bak, "J"), lookat:=xlPart)
        If Not Bul Is Nothing Then
           
            Range(Cells(Bul.row, 1), Cells(Bul.row, 2)).Delete Shift:=xlUp
           
           
        End If
    Next
End Sub

 

[iavdan06]

dalgalıkur hocam 38bin kayıt var elimde j sütununa 200 satırlık veri yazıyorum 5bin kayıt siliyor böyle bişey mümkün değil j sütununa yazdıgım 200 veriden hadi 200 tane aynı kayıt buldugunu varsaysak a sütununda en fazla 200 satır silmesi gerekmez mi bi enteresanlık var

 

[Muzaffer Ali]

200 yerine 10 tane yazın kendiniz manuel kontrol edin kaç tane silinmesi gerektiğini tespit edin.
Sonra kodu çalıştırıp karşılaştırın.

 

[Muzaffer Ali]

Üstadım bu şekilde olması gerekmezmi, yoksa her türlü j den silicek

Sub Test()
    Dim Bak As Long
    Dim Bul As Range
    For Bak = Cells(Rows.Count, "J").End(xlUp).Row To 1 Step -1
        Set Bul = Range("A:B").Find(what:=Cells(Bak, "J"), lookat:=xlPart)
        If Not Bul Is Nothing Then
          
            Range(Cells(Bul.row, 1), Cells(Bul.row, 2)).Delete Shift:=xlUp
          
          
        End If
    Next
End Sub

J sütununda bulunan satır silinmeyecek A ve B sütununda bulunduğunda tüm satır silinecek.
Son yazdığım kod doğrudur.

 

[maliex]

J sütununda bulunan satır silinmeyecek A ve B sütununda bulunduğunda tüm satır silinecek.
Son yazdığım kod doğrudur.

"A ve B sütununda bulunduğunda tüm satır silinecek" işte o zaman j deki masum veride gidiyor..neyse ben karışmıyorum

 

[iavdan06]

"A ve B sütununda bulunduğunda tüm satır silinecek" işte o zaman j deki masum veride gidiyor..neyse ben karışmıyorum

maliex üstadım sen karışma ama senin yazdığın kod işimi gördü