Hücre değerlerini eşleştirerek satırları silmek.

[mekist]

Değerli Üstadlar,

Ekte örnek uygulama dosyam var.
"C" sütunundaki değer "C:C" sütununda aranacak ve aynı değere sahip iki hücre eşleşirse "G" sütunundaki değerlerin eşitliğini kontrol edecek.Eğer onlarda eşitse her iki satırıda silecek.Yanlız burda birde "A" sütununda yer alan
AB,AA,MA ve MB verileri borç alacak mantığını içeriyor.
silinecek satırlardan biri borç ise diğeri alacak olmalı.
Örnek: "C5" AB ise diğer hücre AA veya MA olmalı ki eşitlik bozulmasın.

Bu şekilde bir makro olabilirmi?

Şimdidenteşekkür ederim.

 

[Mahmut Kök]

Aşağıdaki kodları deneyiniz.

Sub borc_alacak()
For i = 1 To Range("a65536").End(3).Row
If i > Range("a65536").End(3).Row Then Exit For
a = Right(Cells(i, "a"), 1)
if a<>"A" and a<>"B" then goto 55
c = Cells(i, "c")
g = Cells(i, "g")
        For ii = i + 1 To Range("a65536").End(3).Row
        If Right(Cells(ii, "a"), 1) <> a And Cells(ii, "c") = c And Cells(ii, "g") = g Then
        Rows(ii).Delete
        Rows(i).Delete
        i = 1
        Exit For
        End If
        Next
55
Next
MsgBox "işlem tamamlandı"
End Sub

 

[mekist]

Aşağıdaki kodları deneyiniz.

Sub borc_alacak()
For i = 1 To Range("a65536").End(3).Row
If i > Range("a65536").End(3).Row Then Exit For
a = Right(Cells(i, "a"), 1)
if a<>"A" and a<>"B" then goto 55
c = Cells(i, "c")
g = Cells(i, "g")
        For ii = i + 1 To Range("a65536").End(3).Row
        If Right(Cells(ii, "a"), 1) <> a And Cells(ii, "c") = c And Cells(ii, "g") = g Then
        Rows(ii).Delete
        Rows(i).Delete
        i = 1
        Exit For
        End If
        Next
55
Next
MsgBox "işlem tamamlandı"
End Sub

Çok teşekkür ederim.

If Right(Cells(ii, "a"), 1) <> a And Cells(ii, "c") = c And Cells(ii, "g") = g

Burda ikinci koşul olarak "d" sütunuda eklenebilirmi."c" sütununda eşleştirme yapıp sildikten sonra "d" sütunu içinde çalıştırıabilirmi?

Birde eşleştirme yaptıktan sonra "g" sütunudaki değerleri eşleştiriyor.Burda 0,01 kuruş farkı olanlarıda eşleşmiş olarak sayıp silebilir miyiz.

Önemli; Bu işlemi 10.000 satırlık veride uyguladığımızda işlemin hızlanması için yapılabilecek bişey varmıdır.

Şimdiden teşekkür ederim.

 

[KUDRETCAN]

bu işlemi sayfa olarak gönderebilirmisiniz. zira kod u çalıştıramadım

 

[mekist]

kimse yardımcı olamayacakmı?

 

[Mahmut Kök]

Çok teşekkür ederim.

If Right(Cells(ii, "a"), 1) <> a And Cells(ii, "c") = c And Cells(ii, "g") = g

Burda ikinci koşul olarak "d" sütunuda eklenebilirmi."c" sütununda eşleştirme yapıp sildikten sonra "d" sütunu içinde çalıştırıabilirmi?

Birde eşleştirme yaptıktan sonra "g" sütunudaki değerleri eşleştiriyor.Burda 0,01 kuruş farkı olanlarıda eşleşmiş olarak sayıp silebilir miyiz.

Önemli; Bu işlemi 10.000 satırlık veride uyguladığımızda işlemin hızlanması için yapılabilecek bişey varmıdır.

Şimdiden teşekkür ederim.

İkinci koşul olarak d sütunu eklenebilir mi diye sormuşsunuz? Yani ilk işlemler bittikten sonra, yukarıdaki kodlarda C yerine D'ye bakarak mı çalışmasını istiyorsunuz? Biraz daha açabilirseniz iyi olur.

 

[mekist]

evet aynen dediğiniz gibi."c" sütununa bakarak silme işlemini yaptıktan sonra "d" sütununa bakarak da satır silsin.

Birde makronun hızlı çalışması için ne yapılabilir.10.000 satırlık veride denendiği zaman donma oluyor.

Tşekkürler,

 

[mekist]

Aşağıdaki kodları deneyiniz.

Sub borc_alacak()
For i = 1 To Range("a65536").End(3).Row
If i > Range("a65536").End(3).Row Then Exit For
a = Right(Cells(i, "a"), 1)
if a<>"A" and a<>"B" then goto 55
c = Cells(i, "c")
g = Cells(i, "g")
        For ii = i + 1 To Range("a65536").End(3).Row
        If Right(Cells(ii, "a"), 1) <> a And Cells(ii, "c") = c And Cells(ii, "g") = g Then
        Rows(ii).Delete
        Rows(i).Delete
        i = 1
        Exit For
        End If
        Next
55
Next
MsgBox "işlem tamamlandı"
End Sub

Mahmut Bey sağolun,

Arkadaşlar bu makro ile en yukarıda detaylı şekilde anlattığım gibi "C" sütununda aynı değere sahip 2 hücre varsa "G" sütnununda bu hücrelerinde eşleştirmesini yaparak her iki satırıda siliyor."A" sütununda yer alan borç alacak denklemini bozmadan Biri borç diğeri alacak olacak şekilde siliyor. Mahmut Bey tekrardan çok sağolun.

Burada 2 konuda daha isteğim olacak,
1-"G" sütununda eşleştirmeyi birebir olarak yapıyor. Tutarları eşleştirirken +/- 0,05 fark olsa da eşleşmiş kabul edebilir mi.
2-Satır sayısı 10 bin civarı olunca epeyce yavaşlıyor. Hızlı sonuç alabilmek adına yapabilecek birşey varmıdır?
Dosyanın makrolu halini yeniden ekliyorum.

 

[mekist]

yardım edebilecek arkadaş var mıdır?

 

[mekist]

yardım edecek arkadaş yok mudur?

 

[mekist]

yardım lütfen

 

[mekist]

yardım edecek arkadaş varmı?