• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Belirli Kelimeleri İçeren Satırı Silme

M

murat1903

Katılım
8 Temmuz 2008
Mesajlar
9
Excel Vers. ve Dili
MS Office Excel 2003 Türkçe
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.
 

Ekli dosyalar

Merhaba,

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

Kod: 
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
.
 
Ç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

Kod: 
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
 
Değer aranan sütun H iken B olarak değişti sanırım.

Bu şekilde deneyiniz.

Kod: 
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.

.
 

Ekli dosyalar

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' Alıntı:
Değer aranan sütun H iken B olarak değişti sanırım.

Bu şekilde deneyiniz.

Kod: 
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.

.
Genişletmek için tıkla ...


Ö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?
 
Merhaba,

Sorunuzu örnek dosya ile desteklemenizi rica ederim.

.
 
Bu şekilde deneyin.

Kod: 
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

.
 
semih58' Alıntı:
bu kodu nereye ekleyeceğim
Genişletmek için tıkla ...

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.

Kod: 
    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
 
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.
 
=Parçaal(A1;12,Uzunluk(A1))
 
*FLAKON* Haricindeki diğer tüm satırları silmek istense kod nasıl olur. Lütfen acil yardım.


Ömer' Alıntı:
Değer aranan sütun H iken B olarak değişti sanırım.

Bu şekilde deneyiniz.

Kod: 
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.

.
Genişletmek için tıkla ...
 
Merhaba,

A sütununa göre:

Kod: 
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

.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst