Excel Silmek İstediğimiz Verileri Toplu silmek

[mert03400x]

Merhaba arkadaslar bir sorum var 2 yıldır aradıgım soruya cevap bulamadım bugun tekrar önüme cıktı.


A sutununda Ahmet-Ali-Veli-Kadir diye alt alta inen isimler var.

Ben Ahmet, Mehmet, Veli isimlerini içeren satırları komple yok etmek ıstıyorum ama malesef bunu tek tek yapabılıyorum şu anda. Bunları toplu halde nasıl sılebılırım?

Teşekkürler.

 

[tahsinanarat]

Sn. Evrengizlen beyin kodları
A sütunun ;
"-" ".tv ".org" ".info" kelimelerini içeren ve 15 haneden uzun olan satırları toplu silmek.

Sub sil59()
Dim sonsat As Long, i As Long
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
For i = sonsat To 1 Step -1
    If Len(Cells(i, "A").Value) > 15 Then
        If InStr(Cells(i, "A").Value, "-") > 0 Or _
            InStr(Cells(i, "A").Value, ".tv") > 0 Or _
            InStr(Cells(i, "A").Value, ".org") > 0 Or _
            InStr(Cells(i, "A").Value, ".info") > 0 Then
            Rows(i).Delete
        End If
    End If
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Asri]

Alternatif;

Aşağıdaki sayfanın ilk mesajındaki eklentiyi, excel mouse sağ tuş da kullanabilirsiniz.

http://www.excel.web.tr/f52/excel-ze...tml#post882817

İstediğiniz işlemin videosu.

https://www.youtube.com/watch?v=xPFH45a2VOQ

* Bu karakterleri kullanarak.Bu kurala göre Taşı/Kopyala . Rakamlar text olarak kabul edilir. Virgül ile ayırınız.

Örnek: elma,armut,kiraz

Verilen kelimeleri, her bir satırdaki hücrelerde aşağıda seçilen kritere göre arar. Bulunanları seçime göre kendi oluşturduğu yeni bir sayfaya taşıma yada kopyalama yapar.

"İle başlayanı"
"İle başlamayanı"
"İle biteni"
"İle bitmeyeni"
"İçereni"
"İçermeyeni"
"Eşit olanı"
"Eşit olmayanı"
"Büyük olanı"
"Küçük olanı"
"Büyük yada eşit olanı"
"Küçük yada eşit olanı"

 

[tahsinanarat]

Altarnatif

Sub SartliSil()

Dim son As Long, deg, i As Long, durum As Boolean, j As Integer

son = Cells(Rows.Count, "A").End(xlUp).Row
deg = Array("*FLAKON*", "*SOLUSYON*", "*AMPUL*", "*ENJEKTOR*", _
            "*SUSPANSIYON*", "*FLK.*", "*KREM*", "*SURUP*", _
            "*TORBA*", "*SOLUSYON*", "*TOZ*", "*DAMLA*", "*SASE*", _
            "*DAMLASI*", "*POMADI*", "*POMAD*", "*SPREY*", "*GARGARA*", _
            "*JEL*", "*MERHEMI*", "*MERHEM*", "*POMAT*", "*SIRINGA*", "*ML*")

Application.ScreenUpdating = False
 
For i = son To 2 Step -1
    durum = False
    For j = 0 To UBound(deg)
        If Cells(i, "A") Like deg(j) Then durum = True
        If durum = True Then Exit For
    Next j
    If durum = True Then Rows(i).Delete Shift:=xlUp
Next i

Application.ScreenUpdating = True

End Sub

 

[mert03400x]

çok teşekkur ederım sizlere.