Belirli Kelimeleri İçeren Satırı Silme

[murat1903]

Merhaba,

Elimde çok uzun bir liste var. Ekte bunun kısaltılmışını bulabilirsiniz.

Benim istediğim bu listede ampul, flakon, solusyon içeren kelimelerin bulunduğu satırların otomatik olarak silinmesi

Varmı bu konuda bana yardımcı olabilecek bir arkadaş?

Şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Module kopyalarak çalıştırınız..

Option Compare Text

Sub SartliSil()

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

son = Cells(Rows.Count, "H").End(xlUp).Row
deg = Array("*ampul*", "*flakon*", "*solusyon*")

Application.ScreenUpdating = False

For i = son To 2 Step -1
    durum = False
    For j = 0 To UBound(deg)
        If Cells(i, "H") 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

.

 

[murat1903]

Çok teşekkürler ama beceremedim. Ben bir kaç kelime daha ekledim, oldumu emin değilim. Size zahmet olacak ama benim için şu dosyaya ekleyip, post edermisiniz. Çok teşekkürler

Option Compare Text
 
Sub SartliSil()
 
Dim son As Long, deg, i As Long, durum As Boolean, j As Integer
 
son = Cells(Rows.Count, "H").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, "H") 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

 

[murat1903]

Dosyayı koymayı unutmuşum

 

[Ömer]

Değer aranan sütun H iken B olarak değişti sanırım.

Bu şekilde deneyiniz.

Option Compare Text
 
Sub SartliSil()
 
Dim son As Long, deg, i As Long, durum As Boolean, j As Integer
 
son = Cells(Rows.Count, "B").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, "B") 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

Dosyanız ektedir.

.

 

[murat1903]

Mükemmel olmuş. Çok teşekkür ederim

 

[darkvenue]

Merhabalar Omer Bey
Bu satır silme islemini aynı anda tüm exceldeki sayfalar için yapmak mümkün müdür?
Bu sanırım sadece aktif sayfada çalışıyor.

 

[Ömer]

Mümkündür. Yeni bir başlıkta örneklendirerek sormanızı rica ederim.

Ayrıca size yaptığım örnek tüm sayfalarda silme işlemini yapmaktadır.

http://www.excel.web.tr/f48/otomatik-satir-sildirme-sorusu-t141726.html

.

 

[BedriA]

Değer aranan sütun H iken B olarak değişti sanırım.

Bu şekilde deneyiniz.

Option Compare Text
 
Sub SartliSil()
 
Dim son As Long, deg, i As Long, durum As Boolean, j As Integer
 
son = Cells(Rows.Count, "B").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, "B") 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

Dosyanız ektedir.

.

Ömer Hocam,

Anladığım kadarıyla bu kodla sadece kodda adı geçen kelimelerin bulunduğu satırlar silinecek. Peki ben butonla birlikte ki Combobox koyup bunlardan seçeceğim değerlerin ikisini de içeren satırı silmek için nasıl bir kod gerekir?

 

[Ömer]

Merhaba,

Sorunuzu örnek dosya ile desteklemenizi rica ederim.

.

 

[BedriA]

Merhaba,

Sorunuzu örnek dosya ile desteklemenizi rica ederim.

.

Ömer Hocam,

Dosya eklendi. Çok teşekkür ederim.

 

[Ömer]

Bu şekilde deneyin.

Private Sub CommandButton1_Click()

    Dim i As Long
 
    Application.ScreenUpdating = False

    For i = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
        If Cells(i, "A") & Cells(i, "L") = _
            ComboBox1.Text & ComboBox2.Text Then
            Rows(i).Delete
        End If
    Next i
     
    Application.ScreenUpdating = True

End Sub

.

 

[BedriA]

Ömer Hocam,

Çok teşekkürler.

 

[semih58]

bu kodu nereye ekleyeceğim

 

[BedriA]

bu kodu nereye ekleyeceğim

Bu kod ile iki ayrı listeden seçilen kelimeleri içeren tüm satırlar sayfadan siliniyor.
Bu kodu kullanabilmeniz için sayfanızdan belli iki sütundan seçilen kelimelerin listelendiği iki açılır listenizin, bir tane de butonunuzun olmazı gerekiyor.

Kodu butona çift tıklayarak çıkacak iki satır arasına kopyalayın.

    Dim i As Long
 
    Application.ScreenUpdating = False

    For i = Cells(Rows.Count, "A").End(xlUp).Row To 3 Step -1
        If Cells(i, "A") & Cells(i, "L") = _
            ComboBox1.Text & ComboBox2.Text Then
            Rows(i).Delete
        End If
    Next i
     
    Application.ScreenUpdating = True

 

[ÇİĞDEMM1]

Merhaba ben de yardım isteyeceğim sizden.mesela 08.11.2017 19:46:29
rakamları bulunan satırda tarih olan yeri silip sadece saat kısmının kalmasını istiyorum.formülle nasıl yapabilirim acaba.

 

[askm]

=Parçaal(A1;12,Uzunluk(A1))

 

[ÇİĞDEMM1]

çok teşekkür ederim.

 

[o2l3m]

*FLAKON* Haricindeki diğer tüm satırları silmek istense kod nasıl olur. Lütfen acil yardım.

Değer aranan sütun H iken B olarak değişti sanırım.

Bu şekilde deneyiniz.

Option Compare Text
 
Sub SartliSil()
 
Dim son As Long, deg, i As Long, durum As Boolean, j As Integer
 
son = Cells(Rows.Count, "B").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, "B") 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

Dosyanız ektedir.

.

 

[Ömer]

Merhaba,

A sütununa göre:

Sub SartliSil()
 
    Dim i As Long
     
    Application.ScreenUpdating = False
     
    For i = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Not UCase(Cells(i, "A")) Like "*FLAKON*" Then
            Rows(i).Delete Shift:=xlUp
        End If
    Next i
     
    Application.ScreenUpdating = True
 
End Sub

.