• DİKKAT

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

Belirli kelimelerin bulunduğu satırları silme

F

FRADKLUF

Katılım
21 Kasım 2011
Mesajlar
10
Excel Vers. ve Dili
Excel 2007
Merhaba arkadaşlar daha bugün kayıt oldum foruma..
Basit bir sorum olacak ama tam istediğim gibi bir kod bulamadım bulsam da çalışmadı.
İstediğim şey;
Elimde tek sütudan oluşan 7000 satırlık bir dosya var satırlarda birçok kelime var.
Ben mesela "page, Media, Stream" gibi kelimelerden herhangi birinin bulunduğu satırları sildirmek istiyorum. Sadece bir tanesinin bulunması silinmesi için yeterli bir koşul. Bunu filtreleme seçeneğinden "contain" ile de yapabilirim fakat sildirmek için arayacığım kelime sayısı baya fazla ve her hafta raporlama yapıyorum ve tek bir seferde halletmek istiyorum.

Umarım uzun olmamıştır mesajım..
 
Ömer bey sizin kodunuza baktım fakat başaramadım. Buraya bir kısmını ekliyorum dosyanın, tamamını ekleyemiyorum şirket güvenliği açısından, fakat bu da meramımı anlatmak için yeterli olacaktır..

DAILY REPORT IneoQuest Technologies
Page 17 of 256 www.ineoquest.com
----------------------- Page 18-----------------------
Page 18 of 256 www.ineoquest.com
----------------------- Page 19-----------------------
Monitor : G2X.HEADEND.ENCODER, Port: 1
Media Outage Outage Duration (Secs) Visual
Flow Name Flow Address/Channel:Frequency:TS ID Impairments
Seconds Counts Min Max Avg

Mesela "Page 17 of 256 www.ineoquest.com" bulunduğu satırı da "----------------------- Page 19-----------------------" bulunduğu satırı da Page kelimesini koşul olarak yazarak silmek istiyorum. Bunun gibi 5 10 tane kelime var yukarıda yazdığım gibi. siz bana bir örnek kod yazabilirseniz ben onu kendime göre uyarlayabilirim.
 
Eklediğiniz kesiti mesaj olarak değil boş bir excele bir kaç örnek ekleyerek dosya şeklinde ekleyiniz.

.
 
Ömer' Alıntı:
Eklediğiniz kesiti mesaj olarak değil boş bir excele bir kaç örnek ekleyerek dosya şeklinde ekleyiniz.

Burda DAILY, Page, Seconds, Media, Flow Name kelimelerinden herhangi birini içermesi yeterli satırın silinmesi için. Normalde bu dosya 7200 satır falan..
Genişletmek için tıkla ...
 

Ekli dosyalar

FRADKLUF' Alıntı:
Burda DAILY, Page, Seconds, Media, Flow Name kelimelerinden herhangi birini içermesi yeterli satırın silinmesi için. Normalde bu dosya 7200 satır falan..
Genişletmek için tıkla ...

Satır sayısı önemli değil. Kodları module kopyalayıp ç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, "A").End(xlUp).Row
    deg = Array("*DAILY*", "*Page*", "*Seconds*", "*Media*", "*Flow Name*")
 
    Application.ScreenUpdating = False
 
    For i = son To 1 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
.
 
Çok teşekkür ederim Ömer bey..bu inanılmaz derecede işimi kolaylaştırdı..
Size bir sorum daha olacak. size gönderdiğim excelin 23. satırında "2011 Nov 04" şeklinde bir tarih var. Bu tarihler belirli satırlarda sadece bir defa yazıyor ve "2011 Nov 14" de bitiyor. Ben bu sıralı taihlerin arasındaki bütün satırların yanına hangi tarih ise onu yazdırmak istiyorum. Mesela "2011 Nov 04" tarihi ile "2011 Nov 05"
tarihi arasındaki bütün satırların yanındaki satıra 2011 Nov 04 yazacak. Bu şekilde devam edecek. Önceden belirteyim bu tarihler hep aynı yerde olmayabiliyor. Bir şekilde bütün satırları kontrol edip sağdaki satıra hangi aralıkta ise o tarihi yazması gerekiyor..
 
2. soru olarak bir satırda bulunan ard arda gelen kelimleri içeren satırları nasıl silebiliriz.
örneğin metin filtrede "deneme ve kitap" gibi
 
Merhaba,

deg = Array("*DAILY*", "*Page*", "*Seconds*", "*Media*", "*Flow Name*")

Bu satırdaki kriterleri değiştirerek deneyin.

Sorunuz daha farklı ise, detaylı açıklama yapmanızı rica ederim.
 
ekte bir dosya var. satırda bulunan "arka duvar", "kavela" vb bir çok anahtar kelime. Bu kelimeleri içeren satırları silmek istiyorum. Yukarıdaki kodu belirttiğiniz kısımlarını değiştirdim fakat herhangi bir satır silme gerçekleşmedi.


ürün adı sütununda metin filtrelerine gelip içerir filtresine tıklayıp; "arka ve duvar", "dıbı veya dibi", "ekmece ve yanı" gibi filtre yapmak istediğim kelimeleri içeren satırları silmek istiyorum.
 

Ekli dosyalar

İstediğiniz bu mu?

Kod: 
Option Compare Text
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("*arka duvar*", "*kavela*")
 
    Application.ScreenUpdating = False
 
    For i = son To 1 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
 
Eklediğiniz dosyada ilgili satırları benim denemem sonucunda sildi. Sorun göremedim.
 
Evet siliyor. Ancak belirttiğim kelimeler, kelimeler arasında olduğu zaman silme işlemi yapmıyor. Örneğin, "arka kutu duvar" arada ek bir kelime olduğu zaman silme yapmıyor.
 
deg satırını aşağıdaki gibi değiştirin.

Kod: 
deg = Array("*arka*duvar*", "*kavela*")

.
 
vermiş olduğunuz kod. arka kutu duvar, kutu arka duvar, kutu arka kutu duvar içinde geçerli midir ?
 
Deneyip gözlemlemeniz daha doğru olacaktır. Eğer tek tek kelime geçecekse her kelimeyi ayrı ayrı yazın.
 
Peki, vermiş olduğunuz programda rastgele bir sütunda belirtilen kelimelerin bulunduğu satırı silme olanağı var mıdır?
 
Merhaba,

Ömer beyin önerdiği koda sütun seçme satırı eklenirse istediğiniz olur. Aşağıdaki gibi deneyiniz.

Kod: 
Option Explicit
Option Compare Text

Sub SartliSil()
 
    Dim sutun As String, son As Long, deg, i As Long, durum As Boolean, j As Integer
 
    sutun = InputBox("İşlem yapmak istediğiniz sütun bilgisini giriniz.", , "A")
    If sutun = "" Then Exit Sub
    son = Cells(Rows.Count, sutun).End(xlUp).Row
    deg = Array("*arka duvar*", "*kavela*")
 
    Application.ScreenUpdating = False
 
    For i = son To 1 Step -1
        durum = False
        For j = 0 To UBound(deg)
            If Cells(i, sutun) 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
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst