Toplu Satır Silme

[hlojan]

Merhaba,

520658 tane satırlı ve 5 sütunlu bir listem var. Gizlilik sebeblerinden örnek dosya ekleyemiyorum

e sütununda hücre boş ise satı silmesi için basit kod yazdım.

for i to 520568

if boş ise

hücre.rows.delete vs.

Ama çok kastı. Saatlerce beklemeler. Yok . Çözemedim.

Daha uygun bir kod var mı acaba. Yaklaşık silincek satır sayısı tahmini 300000 lerde.

Yardımlarınızı bekliyorum

 

[Mahmut Kök]

İlla ki kodla mı yapmak istiyorsunuz bilmiyorum ama şöyle de yapabilirsiniz. Verileri E sütununa göre sıralayın. Sonra E sütunun boş olduğu tüm satırları tek seferde silebilirsiniz.

Kod kullanmak zorundaysanız bahsettiğim işlemi kodla yapabilirsiniz. Mevcut kod kullanımınız için şunu önerebilirim. Döngünün öncesine Application.ScreenUpdating = False döngünün sonrasına da Application.ScreenUpdating = True ekleyebilirsiniz. Bu bariz bir hız farkı yaratır. Ayrıca döngüyü sondan başa doğru yürütmenizi öneririm.

Verileri değiştirilmiş örnek dosya eklerseniz faydalı olur.

İyi çalışmalar...

 

[maliex]

    Columns("E:E").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete

 

[hlojan]

Maliex ve Mahmut bey teşekkürler.

    Columns("E:E").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete

Bunu denemiştim. 4-5 saat beklememe rağmen sonuç alamadım

Application.ScreenUpdating = False

Bunu eklemek aklıma gelmedi. Dediğiniz gibi hız farkı olabilirdi.

Cevap beklerken bir yandan kafa yoruyordum.

Excel de Power Query özelliği ile saniyeler içinde yapabildim. Boş satırları kaldır ile.

Eğer başkasıda aynı bilgiyi ararsa diye yazmak istedim

Tekrar teşekkürler

 

[Korhan Ayhan]

Aşağıdaki kod ile bahsettiğiniz satırlı bir tabloda 7-8 saniyede sonuç alabildim.

Option Explicit

Sub Bos_Satirlari_Hızlıca_Sil_Dizi_Yontemi()
    Dim S1 As Worksheet, Veri As Variant, Son As Long, X As Long
    Dim Y As Byte, Say As Long, Bos_Kayit_Say As Long, Zaman As Double
    
    Zaman = Timer
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set S1 = Sheets("Sheet1")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 2 Then Son = 3
    
    Veri = S1.Range("A2:E" & Son).Value
    
    ReDim Bosluksuz_Liste(1 To UBound(Veri, 1), 1 To 5)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 5) <> "" Then
            Say = Say + 1
            For Y = 1 To UBound(Veri, 2)
                Bosluksuz_Liste(Say, Y) = Veri(X, Y)
            Next
        Else
            Bos_Kayit_Say = Bos_Kayit_Say + 1
        End If
    Next
    
    If Bos_Kayit_Say > 0 Then
        S1.Range("A2:E" & S1.Rows.Count).ClearContents
        S1.Range("A2").Resize(UBound(Bosluksuz_Liste, 1), UBound(Bosluksuz_Liste, 2)) = Bosluksuz_Liste
        
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
        
        MsgBox "Boş kayıtlar silinmiştir." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        With Application
            .ScreenUpdating = False
            .EnableEvents = False
            .Calculation = xlCalculationManual
        End With
        
        MsgBox "Silinecek kayıt bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
End Sub

 

[hlojan]

Korhan Bey;

Teşekkür ederim.

İşimi halletmiştim ama arşivime atmak adına denemek istedim.

Kodunuzu kullandım 9,80 saniyede çözdü

Gerçekten başarılı bir Kod

İlginiz ve bilginiz için teşekkür ederim

 

[Korhan Ayhan]

Siz Power Query ile kaç saniyede halletiniz?

 

[hlojan]

Power Query ile açınca 1 sn de siliyor. Ama kaydet ve Kapatı tıklayınca ( Tabloyu yeni sheet açıp yazıyor ) 12 sn sürüyor.

 

[Korhan Ayhan]

Bilgi için teşekkürler.

Alternatif olarak ADO yöntemiyle çözüm ektedir.

Bu yöntem ile bende yaklaşık 15-16 saniyede işlem tamamlanıyor.

Kayıt Seti kilit tipi desteği için @Erdem_34 beye teşekkür ederim.

Option Explicit

Sub Bos_Satirlari_Hizlica_Sil_Ado_Yontemi()
    Dim Dosya As String, Zaman As Double, S1 As Worksheet, Son As Long
    Dim Kayit_Seti As Object, Baglanti As Object, Sorgu As String
   
    Zaman = Timer
   
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    Set S1 = Sheets("Sheet1")
   
    Dosya = ThisWorkbook.FullName

    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select * From [" & S1.Name & "$] Where F5 Is Not Null"
   
    Kayit_Seti.Open Sorgu, Baglanti, 3, 1
   
    If Kayit_Seti.RecordCount > 0 Then
        S1.Range("A1:E" & S1.Rows.Count).ClearContents
        S1.Range("A1").CopyFromRecordset Kayit_Seti
    End If
   
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
   
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
   
    If Son > S1.Cells(S1.Rows.Count, 1).End(3).Row Then
        MsgBox "Boş kayıtlar silinmiştir." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        MsgBox "Silinecek kayıt bulunamadı!", vbExclamation
    End If

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    Set S1 = Nothing
End Sub