Koşullu Satırlar silme

[hüseyintok]

Merhaba I kolonunda eğer "0" değeri varsa bulunduğu satır ve üstündeki 4 satır silinmesi için makroya ihtiyacım var. yardımcı olurmusunuz

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Conditional_Delete_Rows()
    Dim Rng As Range, My_Area As Range
    
    For Each Rng In Range("I3:I" & Cells(Rows.Count, "I").End(3).Row)
        If Rng.Value = 0 And Len(Rng) > 0 Then
            If My_Area Is Nothing Then
                Set My_Area = Rng.Offset(-4).Resize(5)
            Else
                Set My_Area = Union(My_Area, Rng.Offset(-4).Resize(5))
            End If
        End If
    Next
    
    If Not My_Area Is Nothing Then
        My_Area.EntireRow.Delete
        MsgBox "Tespit edilen satırlar silinmiştir."
    Else
        MsgBox "Uygun veri bulunamadı!", vbExclamation
    End If
End Sub

 

[hüseyintok]

Korhan hocam çok teşekkürler. Tek sorun Sıfır olan satırlar silindikten sonra düzensiz satır boşlukları kalıyor aralarda. bunu halletmek mümkün mü?

 

[mühendisberke]

Kritik olan 0'a gelince if içinde for döngüsüyle defalarca silmek.
Bir de boşlukların 0 sayılmaması

Sub satır4silodev()
Dim iCon As Long
Dim jCon As Long
Dim xVar As Long
jCon = ActiveCell.Column
For iCon = 50 To 1 Step -1
If Cells(iCon, jCon) <> "" And Cells(iCon, jCon) = 0 Then
For xVar = 5 To 1 Step -1
Rows(iCon).Delete
Next
End If
Next
End Sub

 

[Korhan Ayhan]

Merhaba,

Merhaba I kolonunda eğer "0" değeri varsa bulunduğu satır ve üstündeki 4 sa

Talebinizde düzenin korunmasıyla ilgili bir açıklama göremedim. Talebinize göre cevabı verdiğimi düşünüyorum.

Düzen için aşağıdaki kodu deneyebilirsiniz. Örnek dosyanızda bloklar arasında 2 satır boşluk var. Fakat son blokta 3 satır boşluk var. Ben hepsinin 2 satır boşluklu olduğunu varsaydım.

Option Explicit

Sub Conditional_Delete_Rows()
    Dim Rng As Range, My_Area As Range
    
    For Each Rng In Range("I3:I" & Cells(Rows.Count, "I").End(3).Row)
        If Rng.Value = 0 And Len(Rng) > 0 Then
            If My_Area Is Nothing Then
                Set My_Area = Rng.Offset(-4).Resize(7)
            Else
                Set My_Area = Union(My_Area, Rng.Offset(-4).Resize(7))
            End If
        End If
    Next
    
    If Not My_Area Is Nothing Then
        My_Area.EntireRow.Delete
        MsgBox "Tespit edilen satırlar silinmiştir."
    Else
        MsgBox "Uygun veri bulunamadı!", vbExclamation
    End If
End Sub