1 hariç Diğer satıları sil..!

[Korhan Ayhan]

Merhaba,

Ben filtre yöntemini size değil Sn. snx111 beye önerdim.

Ayrıca size önerdiğim kodu ben "I" sütununa aşağıdaki şekilde yaklaşık 65000 satır veri girerek hız testi yaptım. Sonuç çok başarılı değildi. Sizin kullandığınız veride 1 içermeyen hücre sayısı az ise çok hızlı sonuç verebilir.

Örnek;

1
xx
1
xx
1

Bu şekilde olan ve veri sayısı 65000 civarında olan bir tabloda işlem çok uzun sürmektedir. Bu sebeplede size #10 nolu mesajımdaki kodu kullanmanızı tavsiye ettim.

 

[sensizsoldum]

Merhaba,
Benim Çalışmada o veri yaklaşık 5000 kadar o nedenle hızlı çalışıyor olabilir.
Teşekkür ederim, Tekrardan.

 

[Korhan Ayhan]

Merhaba,

Önerdiğim kodları tekrar gözden geçirdim. Arada bir döngü fazladan kullanmışım. Kodu aşağıdaki şekilde revize ettim.

"AA" sütununu yardımcı sütun olarak kullandım.

İ7 işlemci ile;

65000 satırda aldığım süre sonuçları;

Böyle bir data içerisine 40000 adet 1 değeri serpiştirdim. Yaklaşık işlem süresi 10 saniye sürdü.

Böyle bir data içerisine 30000 adet 1 değeri serpiştirdim. Yaklaşık işlem süresi 20-22 saniye arasında sürdü.

Yine aynı satırdaki data içerisine bu sefer 13000 civarında 1 değeri serpiştirdim. Yaklaşık işlem süresi 10 saniye sürdü.

Yine aynı satırdaki data içerisine bu sefer 2600 civarında 1 değeri serpiştirdim. Yaklaşık işlem süresi 8 saniye sürdü.

Yine aynı satırdaki data içerisine bu sefer 1300 civarında 1 değeri serpiştirdim. Yaklaşık işlem süresi 8 saniye sürdü.

Yine aynı satırdaki data içerisine bu sefer 650 civarında 1 değeri serpiştirdim. Yaklaşık işlem süresi 8 saniye sürdü.


Eğer bu kodu kullanmayı düşünürseniz "AA" sütunu yerine başka boş bir sütun adresinide kullanabilirsiniz.

Option Explicit
Option Base 1
 
Sub Koşullu_Satır_Sil()
    Dim Veri(), Alan As Range, Satir As Long
    Dim X As Long, Bul As Long, Zaman As Double
    Dim Say As Long, Katsayi As Integer
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    Zaman = Timer
    Katsayi = 1000
 
    Satir = Cells(Rows.Count, "I").End(3).Row
    If Satir < 3 Then GoTo Son
    
    Say = Evaluate("=SUM(IF(I3:I" & Satir & "<>1,IF(I3:I" & Satir & "<>"""",1)))")
    If Say = 0 Then GoTo Son
    With Range("AA3:AA" & Satir)
        .Formula = "=ROW()"
        .Value = .Value
    End With
    
10
    Satir = Cells(Rows.Count, "I").End(3).Row
    If Satir < 3 Then GoTo Son
    
    If Satir = 3 Then
        If Cells(Satir, "I") <> 1 Then
            Rows(Satir).Delete
        End If
    Else
    
        Bul = Evaluate("=MIN(IF(I3:I" & Satir & "<>1,IF(I3:I" & Satir & "<>"""",ROW(I3:I" & Satir & "))))")
        If Bul >= 3 Then
            If Bul + Katsayi - 1 > Rows.Count Then
                Veri = Range("I" & Bul & ":I" & Rows.Count).Value
            Else
                Veri = Range("I" & Bul & ":I" & Bul + Katsayi - 1).Value
            End If
            
            ReDim Dizi(UBound(Veri))
            Say = Bul - 1
            
            For X = 1 To UBound(Veri)
                Say = Say + 1
                
                If Veri(X, 1) <> "1" Then
                    If Alan Is Nothing Then
                        Set Alan = Range("I" & Say)
                    Else
                        Set Alan = Application.Union(Alan, Range("I" & Say))
                    End If
                End If
            Next
            
            If Not Alan Is Nothing Then
                Alan.EntireRow.Value = Empty
            End If
            
            Erase Veri
            Set Alan = Nothing
        End If
    End If
    
    Say = Evaluate("=SUM(IF(I3:I" & Satir & "<>1,IF(I3:I" & Satir & "<>"""",1)))")
    If Say > 0 Then GoTo 10
    
Son:
    
    Range("3:" & Rows.Count).Sort Key1:=Range("AA3"), Order1:=xlAscending
    Range("AA:AA").Clear
    
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi; " & Format(Timer - Zaman, "0.0000"), vbInformation
End Sub

 

[sensizsoldum]

Merhaba
Günaydın, hayırlı sabahlar Korhan Bey.
Normal tek çekirdek bir PC de kullanıyorum bir önceki verdiğiniz kodları I3:I aralığındaki verileri saliseler içinde yapıyor. Bunun gibi tam tamına 9 sütundan ayrı ayrı değerlere göre satır silme işlemi yapıyorum, daha sonra kalan verileri bir başka sayfaya aktarıyorum aktarmadan önce o sayfada ne kadar veri onları da siliyor. Yani toplam bu işlemin hepsini sorunsuz sağlıklı bir biçimde, 3 ila 5 saniye arasında sonuçlandırıyor. İ7 bir işlemcide bunun çalışma hızını düşünemiyorum. Benim gördüğüm bu kodları çalıştırdığım esnada ekranın 2 kere hızlı yanıp sönmesi fotoğraf çeker gibi yani.
Sonsuz teşekkür ederim, konuya sonuna kadar destek olduğunuz için. Bir önceki kodu yenilemek istemiyorum

İyi çalışmalar dilerim.

 

[baydeniro]

Çok teşekkürler sayın uzmanamele.