Koşula Bağlı Satır Silme

[Engin]

Merhaba,

Elimde bir excel tablosu mevcut günlük olarak değişmektedir, ilgili tabloada koşula bağlı olarak makro ile satır silmem mümkün müdür?

1'inci koşul, W stununda Kontrol Edilmiştir yazıyor ise satırının tamamı silinecek
2'inci koşul, V stununda Listede Yok yazıyor ise N stunun kontrol edilecek Ücretli yazan satırları silecek

Böyle bir makro çalışması yapılması mümkün müdür

[erseldemirel]

Bir deneyiniz test sayfasında a sütunu son dolu satırdan itibaren çalışması lazım

Kod: Tümünü seç

Sub TEST()
     Set ws = ThisWorkbook.Sheets("TEST")
    sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 
    For i = sonSatir To 2 Step -1
        If ws.Cells(i, 23).Value = "Kontrol Edilmiştir" Then
            ws.Rows(i).EntireRow.Delete
        ElseIf ws.Cells(i, 22).Value = "Listede Yok" And ws.Cells(i, 14).Value = "Ücretli" Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next i
End Sub

[karisma61]

Kod: Tümünü seç

Dim sonSatir As Long, i As Long
    
    ' Son satır numarasını bul
    sonSatir = Cells(Rows.Count, "W").End(xlUp).Row
    
    ' Kontrol Edilmişleri Sil
    For i = sonSatir To 1 Step -1
        If Cells(i, "W").Value = "Kontrol Edilmiştir" Then
            Rows(i).EntireRow.Delete
        End If
    Next i
    
    ' Listede Yok ve Ücretli olanları sil
    For i = sonSatir To 1 Step -1
        If Cells(i, "V").Value = "Listede Yok" And Cells(i, "N").Value = "Ücretli" Then
            Rows(i).EntireRow.Delete
        End If
    Next i

[Engin]

Kod: Tümünü seç

Dim sonSatir As Long, i As Long
    
    ' Son satır numarasını bul
    sonSatir = Cells(Rows.Count, "W").End(xlUp).Row
    
    ' Kontrol Edilmişleri Sil
    For i = sonSatir To 1 Step -1
        If Cells(i, "W").Value = "Kontrol Edilmiştir" Then
            Rows(i).EntireRow.Delete
        End If
    Next i
    
    ' Listede Yok ve Ücretli olanları sil
    For i = sonSatir To 1 Step -1
        If Cells(i, "V").Value = "Listede Yok" And Cells(i, "N").Value = "Ücretli" Then
            Rows(i).EntireRow.Delete
        End If
    Next i

Merhaba, Sorunsuz çalışıyor teşekkür ederim, fakat veriler arttığında yavaşlıyor ve geç siliyor

[Engin]

Bir deneyiniz test sayfasında a sütunu son dolu satırdan itibaren çalışması lazım

Kod: Tümünü seç

Sub TEST()
     Set ws = ThisWorkbook.Sheets("TEST")
    sonSatir = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 
    For i = sonSatir To 2 Step -1
        If ws.Cells(i, 23).Value = "Kontrol Edilmiştir" Then
            ws.Rows(i).EntireRow.Delete
        ElseIf ws.Cells(i, 22).Value = "Listede Yok" And ws.Cells(i, 14).Value = "Ücretli" Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next i
End Sub

Merhaba, Sorunsuz çalışıyor teşekkür ederim, fakat veriler arttığında yavaşlıyor ve geç siliyor

[erseldemirel]

Kodun en başına Application.ScreenUpdating = False en sonunada Application.ScreenUpdating = True ekleyin hızlandırır

[Engin]

Kodun en başına Application.ScreenUpdating = False en sonunada Application.ScreenUpdating = True ekleyin hızlandırır

tşk ederim kolay gelsin.