Toplamları Sağlayan Verileri silme

[kasif2]

http://www.excel.web.tr/f50/excelde-2-ayry-tabloda-ortak-olan-deoerlerin-silinmesi-t9009/sayfa3.html

Yukarıdaki konudan oluşan kodu aşağıdaki şekilde kullanıyorum ama bi sorun var, eşleşmeyi bulduktan sonra en baştan yeniden aramaya başlıyor, bu yüzden çok yavaş çalışıyor ve çok fazla veri olduğunda kullanışsız oluyor.

Eşleşeni bulduktan sonra yeniden başlamayacak şekilde yapılabilir mi?

Kod bu;

Sub sil_1e1()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row
If Cells(x, 3) = Cells(y, 9) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e1
End If
Next y, x
End Sub
Sub sil_1e2()

For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row - 1
For z = y + 1 To [I65536].End(3).Row

Union(Cells(x, 3), Cells(y, 9), Cells(z, 9)).Select

If Cells(x, 3) = Round(Cells(y, 9) + Cells(z, 9), 2) Then

Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp

Call sil_1e2
End If
Next z, y, x

End Sub
Sub sil_1e3()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row - 2
For z = y + 1 To [I65536].End(3).Row - 1
For t = z + 1 To [I65536].End(3).Row
Union(Cells(x, 3), Cells(y, 9), Cells(z, 9), Cells(t, 9)).Select
If Cells(x, 3) = Round(Cells(y, 9) + Cells(z, 9) + Cells(t, 9), 2) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & t & ":K" & t).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e3
End If
Next t, z, y, x
End Sub
Sub sil_1e4()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row - 3
For z = y + 1 To [I65536].End(3).Row - 2
For t = z + 1 To [I65536].End(3).Row - 1
For v = t + 1 To [I65536].End(3).Row
Union(Cells(x, 3), Cells(y, 9), Cells(z, 9), Cells(t, 9), Cells(v, 9)).Select
If Cells(x, 3) = Round(Cells(y, 9) + Cells(z, 9) + Cells(t, 9) + Cells(v, 9), 2) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & v & ":K" & v).Delete shift:=xlUp
Range("G" & t & ":K" & t).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e4
End If
Next v, t, z, y, x
End Sub
Sub sil_1e5()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row - 4
For z = y + 1 To [I65536].End(3).Row - 3
For t = z + 1 To [I65536].End(3).Row - 2
For v = t + 1 To [I65536].End(3).Row - 1
For r = v + 1 To [I65536].End(3).Row
Union(Cells(x, 3), Cells(y, 9), Cells(z, 9), Cells(t, 9), Cells(v, 9), Cells(r, 9)).Select
If Cells(x, 3) = Round(Cells(y, 9) + Cells(z, 9) + Cells(t, 9) + Cells(v, 9) + Cells(r, 9), 2) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & r & ":K" & r).Delete shift:=xlUp
Range("G" & v & ":K" & v).Delete shift:=xlUp
Range("G" & t & ":K" & t).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e5
End If
Next r, v, t, z, y, x
End Sub
Sub sil_1e6()
For x = 3 To [C65536].End(3).Row
For y = 3 To [I65536].End(3).Row - 5
For z = y + 1 To [I65536].End(3).Row - 4
For t = z + 1 To [I65536].End(3).Row - 3
For v = t + 1 To [I65536].End(3).Row - 2
For r = v + 1 To [I65536].End(3).Row - 1
For s = r + 1 To [I65536].End(3).Row
Union(Cells(x, 3), Cells(y, 9), Cells(z, 9), Cells(t, 9), Cells(v, 9), Cells(r, 9), Cells(s, 9)).Select
If Cells(x, 3) = Round(Cells(y, 9) + Cells(z, 9) + Cells(t, 9) + Cells(v, 9) + Cells(r, 9) + Cells(s, 9), 2) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & s & ":K" & s).Delete shift:=xlUp
Range("G" & r & ":K" & r).Delete shift:=xlUp
Range("G" & v & ":K" & v).Delete shift:=xlUp
Range("G" & t & ":K" & t).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e6
End If
Next s, r, v, t, z, y, x
End Sub

 

[kasif2]

Sanırım çözümü yok

 

[Levent Menteşoğlu]

Bu tip satır silme işlemlerinde döngüyü aşağıdan yukarı doğru çalıştırmak doğru olandır. Örneğin, ilgili prosedürü aşağıdaki gibi değiştirerek deneyin. Diğerlerinide aynı mantıkla düzenleyebilirsiniz.

Sub sil_1e1()
For x = [C65536].End(3).Row To 3 Step -1
For y = [I65536].End(3).Row To 3 Step -1
If Cells(x, 3) = Cells(y, 9) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
End If
Next y, x
End Sub