Koşullu satır silme

[genckalemsor]

merhaba bana bir makro lazım. ekteki dosyada gösterdiğim gibi belli bir hedefteki istediğim rakamı bulup o rakamın olduğu satırı saklayacak diğer satırları silecek.
yardımcı olursanız sevinirim.

 

[genckalemsor]

61 görüntülenme 0 cevap. o kadar yardım edecek kimse yok mu?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Option Explicit
 
Sub KOŞULLU_SATIR_SİL()
    Dim X, Veri
    
    Veri = Application.InputBox("Aradığınız değeri giriniz!")
    
    If Veri = False Or Veri = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For X = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        If WorksheetFunction.CountIf(Range("B" & X & ":E" & X), Veri) = 0 Then
            Rows(X).Delete
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[genckalemsor]

Merhaba,

Aşağıdaki kodu deneyiniz.

Option Explicit
 
Sub KOŞULLU_SATIR_SİL()
    Dim X, Veri
    
    Veri = Application.InputBox("Aradığınız değeri giriniz!")
    
    If Veri = False Or Veri = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For X = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        If WorksheetFunction.CountIf(Range("B" & X & ":E" & X), Veri) = 0 Then
            Rows(X).Delete
        End If
    Next
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Çok teşekkür ederim. çalışıyor fakat bir şey eksik. bu komutu butun sayfaya değil seçtiğim alanda aradığım değer varsa o satırı silenini yapabilirseniz sevinirim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu deneyiniz.

Option Explicit
 
Sub KOŞULLU_SATIR_SİL()
    Dim Veri As Variant, Alan As Range, Silinecek_Alan As Range, Satir As Long
    
    Veri = Application.InputBox("Aradığınız değeri giriniz!")
    
    If Veri = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    
    For Each Alan In Selection
        If Satir <> Alan.Row And Alan.Row > 1 Then
            Satir = Alan.Row
            If WorksheetFunction.CountIf(Alan.Resize(1, Selection.Columns.Count), Veri) = 0 Then
                If Silinecek_Alan Is Nothing Then
                    Set Silinecek_Alan = Alan
                Else
                    Set Silinecek_Alan = Application.Union(Silinecek_Alan, Alan)
                End If
            End If
        End If
    Next
    
    Silinecek_Alan.EntireRow.Delete
        
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[genckalemsor]

Kusursuz! Çok teşekkür ederim.