değeri 0 olan satırı silme

[hasancivi]

merhabalar,

büyük bi data için 'J' sutunundaki değeri 0 olan tüm satırları silecek bi formül lazım, yardımcı olabilirseniz sevinirim.

 

[Ömer BARAN]

Merhaba. Foruma hoşgeldiniz.
Aşağıdaki kod'u sayfanın kod bölümüne yapıştırın ve çalıştırın.
Son satır olarak I sütunundaki dolu son satır düşünüldü, 1'inci satırın başlık satırı olduğu varsayıldı..
J sütunundaki BOŞ hücrelerin bulunduğu satırların da silinmesini istiyorsanız kırmızı kısmı silerek uygulayın.

Silinecek satırlara başvuru yapan formülleriniz varsa sorun yaşarsınız, dikkatli olmanızı öneririm.

Sub BARAN()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

son = [[B][COLOR="blue"]I[/COLOR][/B]65536].End(3).Row

For a = son To 2 Step -1
    If [COLOR="Red"]Cells(a, 10) <> "" And[/COLOR] Cells(a, 10) = 0 Then
        Rows(a & ":" & a).Delete Shift:=xlUp
    End If
Next

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Korhan Ayhan]

Merhaba,

Ömer bey cevabınızı vermiş. Fakat sorunuzda büyük bir data olduğundan bahsetmişsiniz. Silme işlemlerinde standart döngü yerine koşula uyan satırları bir yerde biriktirip tek hamlede silmek oldukça hız kazandıracaktır.

Aşağıdaki kodu ve Ömer beyin önerdiği kodu büyük bir datada deneyip sonucu gözlemleyebilirsiniz.

Sub Sifir_Olan_Satirlari_Sil()
    Dim X As Long, Alan As Range, Son As Long, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    On Error GoTo 0
    
    If Son > 0 Then
        For X = 1 To Son
            If Cells(X, "J") <> "" And Cells(X, "J") = 0 Then
                If Alan Is Nothing Then
                    Set Alan = Cells(X, "J")
                Else
                    Set Alan = Union(Alan, Cells(X, "J"))
                End If
            End If
        Next
    End If
    
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
    End If
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.000") & " Saniye", vbInformation
End Sub

 

[Korhan Ayhan]

Birde filtre yöntemiyle satırları silebilirsiniz.

Bu yöntemde gayet hızlıdır.

Sub Sifirlari_Sil()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    With ActiveSheet
        .Range("$J$1:$J$" & .Rows.Count).AutoFilter Field:=1, Criteria1:="0"
        .Range("J2:J" & .Rows.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .ShowAllData
    End With
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[hasancivi]

çok Teşekkür ederim arkadaşlar,Ömer Beyin kodu denedim direk halloldu, ellerinize sağlık.

 

[kayserciyes]

C8:M24 aralığındaki G sütununda türü "B" olanların YANİ B içeren satırları
kod ile nasıl silebilirim.

örnekleri uyarlayamadım tüm satırı siliyor hepsi
Yardımlarınız için teşekkür ederim şimdiden

 

[ÖmerBey]

Satırı silmeden sadece veriyi silmek istiyorsanız aşağıdaki kod işinizi görecektir. İyi çalışmalar...

Sub KOD()
For a = 8 To 24
    If Cells(a, "G") = "B" Then Range("C" & a & ":M" & a).ClearContents
Next
End Sub

 

[kayserciyes]

Elllerinize sağlık gerçekten çok teşekkür ediyorum
bu excele sinir oluyorum
o kadar uğraşıyorum sonra biri kısacık bir kodla sorunu çözüyor )
merak ediyorum kod yazmak veya programlama öğrenmek için ileri düzey bir matematik bilgisi gerekiyor mu

 

[ÖmerBey]

İleri düzey kodlar için gerekiyor olabilir, ancak temel kodlarda temel excel bilgisi yeterli olur kanaatindeyim. Birazcık özel zaman ayırmak gerekiyor sadece.
Aşağıdaki linkte yer alan video derslerinden başlamanızı tavsiye ederim.
Video Dersane
İyi çalışmalar...

 

[kayserciyes]

Teşekkürler Üsdat

 

[ÖmerBey]

Rica ederim, iyi çalışmalar...