Büyük dosyada satır silmek

[tseker71]

Herkese selamlar

950 bin satırlık büyük bir rapor çıktım var. bunların içerinde binlerce satırlık (peşpeşe satırlar değiller, filtreleme ile çıkan sonuçlar) kimi veriyi silmek istiyorum ancak Excel kilitlenip kalıyor, bazen 10 dakikaya kadar bekliyorum ancak sonuç ne olacak tahmin edemediğimden daha fazla beklemek istemeyip kapatıyorum dosyayı.

Makro ile seçili satırları sil dedim yine yapamadım, veriyi Powerquery de açıp silmeyi denedim onda da başaramadım.

Bunun bir yolu var mıdır yoksa dosya satırları küçük parçalara ayırarak deneme yoluna mı gitmeliyim?

 

[muhasebeciyiz]

Sub HızlıFiltreVeSil()
    Dim son As Long
    Dim rng As Range, unionRange As Range
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    ws.AutoFilterMode = False
    ws.Range("AC1").AutoFilter Field:=1, Criteria1:="-"
    
    son = ws.Cells(ws.Rows.Count, "AC").End(xlUp).Row
    
    On Error Resume Next
    Set rng = ws.Range("AC2:AC" & son).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not rng Is Nothing Then
        For Each cell In rng
            If unionRange Is Nothing Then
                Set unionRange = cell
            Else
                Set unionRange = Union(unionRange, cell)
            End If
        Next cell
        
        If Not unionRange Is Nothing Then
            unionRange.EntireRow.Delete
        End If
    End If
    
    ws.AutoFilterMode = False
End Sub

Bu yöntem, tek tek satırları silmek yerine, tüm seçili satırları tek seferde silerek işlemi hızlandırabilir.

 

[tseker71]

Çok teşekkür ederim,

"AC" sütununda filtreleme yaptım ve "-" tire olan satırları silmesini istedim. Fakat resimdeki gibi hata verdi.

http://imgur.com/NUVXVtQ

http://imgur.com/NUVXVtQ

 

[muhasebeciyiz]

Sub FiltreleVeSil()

    Dim son As Long
    Dim rng As Range
    Dim cell As Range
    Dim i As Long

    ' "-" filtrele
    Range("AC1").AutoFilter Field:=1, Criteria1:="-"
    
    son = Cells(Rows.Count, "AC").End(xlUp).Row
    
    On Error Resume Next
    Set rng = Range("AC2:AC" & son).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Not rng Is Nothing Then       
        For i = rng.Areas.Count To 1 Step -1
            For j = rng.Areas(i).Cells.Count To 1 Step -1
                If rng.Areas(i).Cells(j).Value = "-" Then
                    rng.Areas(i).Cells(j).EntireRow.Delete
                End If
            Next j
        Next i
    End If

    ActiveSheet.AutoFilterMode = False

End Sub

Lütfen deneyiniz

 

[tseker71]

ilginiz için teşekkür ederim,
sizi daha fazla yormak istemem
sadece bilgi için iletiyorum

düzelt dediğimde işaretlediğim satıra gönderme yapıyor

http://imgur.com/RPGZKoN

 

[muhasebeciyiz]

4 nolu mesajı gncelledim.
Hata mesajınız "Error 424: Object required" ve bu genellikle bir nesne atanmadığında veya Set ifadesi doğru bir şekilde kullanılmadığında ortaya çıkar.

 

[tseker71]

Çok teşekkür ederim

ilk kodunuz da hata vermedi fakat sadece bir satır varsa silebildi, çoklu satırlarda silme işlemi yapmadı.

ikinci kodunuzda hata ortadan kalktı ancak o da bir satır varsa silebildi, çoklu satırlarda silme işlemi yapmadı.

Sanıyorum sınırdaki satır sayılarında Excel çalışmıyor, tekrar çok teşekkürler.

 

[halily]

harici bir siteye örnek bir dosya ekleyip ne olmasını islediğinizi örnekler üzerinden açıklarsanız çözüm üretmek daha kolay olur

 

[muratboz06]

Deneyiniz.

Sub HızlıSatırSil()
    Dim ws As Worksheet
    Dim sonSatir As Long
    Dim i As Long
    Dim silSutun As String
    Dim silDeger As String

    ' Ayarlar:
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfanızın adı
    silSutun = "AC" ' Kontrol edilecek sütun (örneğin "C")
    silDeger = "-" ' Bu değer varsa satır silinecek

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    sonSatir = ws.Cells(ws.Rows.Count, silSutun).End(xlUp).Row

    ' Baştan sona değil, sondan başa silmek güvenlidir
    For i = sonSatir To 2 Step -1
        If ws.Cells(i, silSutun).Value = silDeger Then
            ws.Rows(i).Delete
        End If
    Next i

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    MsgBox "İşlem tamamlandı!", vbInformation
End Sub

 

[Korhan Ayhan]

Merhaba,

Bu kadar yüksek satırlı tabloda fiziksel satır silmek kilitlenmeye sebep olabilir.

Bunun yerine verileri diziye alıp silinecek verileri hafızada işleyip sayfaya yeniden yazdırılması daha hızlı sonuç verecektir.

 

[tseker71]

teşekkür ederim

 

[Korhan Ayhan]

Merhaba,

Bahsettiğim düzene uygun makro örneği;

Verilerinizi yedekledikten sonra deneyiniz..

1.000.000 satırlık veride yaklaşık 40 saniyede sonuç veriyor. Silinecek satır sayısı artarsa süre değişebilir..

Option Explicit

Sub Delete_Row_Big_Data()
    Dim My_Data As Variant, Clean_Data As Variant
    Dim X As Long, Y As Integer
    Dim No As Long, First_Time As Double
   
    First_Time = Timer
   
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
   
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
   
    My_Data = Range("A1").CurrentRegion.Value
   
    ReDim Clean_Data(1 To UBound(My_Data, 1), 1 To UBound(My_Data, 2))
   
    For X = 1 To UBound(My_Data, 1)
        If My_Data(X, 29) <> "-" Then
            No = No + 1
            For Y = 1 To UBound(My_Data, 2)
                Clean_Data(No, Y) = My_Data(X, Y)
            Next
        End If
    Next
   
    Cells.ClearContents
   
    Range("A1").Resize(No, UBound(My_Data, 2)) = Clean_Data

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

    MsgBox "AC sütunundaki gereksiz satırlar temizlenmiştir." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - First_Time, "0.00") & " Saniye"
End Sub

 

[tseker71]

çok teşekkür ederim,
mutlu bayramlar

 

[Korhan Ayhan]

Değişken tanımlamasında küçük bir revize yaptım. Son halini denersiniz...