Bazı Satırları Aynı Anda Silebilmek

ÆSir

Dora
Altın Üye
Katılım
15 Ocak 2018
Mesajlar
225
Excel Vers. ve Dili
2015 TR
Altın Üyelik Bitiş Tarihi
20-05-2025
Günaydın,

Ekteki dosyanın C sütununda eğer aşağıdaki kelimeler varsa bulunan satır komple silindir istiyorum.

ALFA ROMEO, AUDI, BMC, BMW, CHRYSLER, CHEVROLET, CITROEN, DAEWOO, DAF, DFM, DODGE, FARGO, FIAT, FORD, GELLY, HINO, ISUZU, IVECO, JAGUAR, JEEP, JOHN DEERE, KARSAN, LADA, LANCIA, LAND ROVER, LDV, LEXUS, MAGIRUS, MAN, MERCEDES, MINICOOPER, OPEL, PEUGEOT, PORSCHE, ROVER, SAAB, SAMSUNG, SEAT, SKODA, SMART, SSANGYONG, SUBARU, TATA, VOLKSWAGEN, VOLVO, YAMAHA, VW

Fakat önemli bir durum söz konusu

Bu kelimelerin içerdiği hücrede;

DACIA, HONDA, HYUNDAI, KIA, MAZDA, MITSUBISHI, NISSAN, PROTON, RENAULT, SUZUKI, TOYOTA

kelimeleri de geçiyorsa o satır silinmemeli. Normalde filtrele ile güzelce siliyordum ama

*KIZDIRMA BUJISI (RENAULT:CLIO-MEGANE-KANGOO 1.5DCI-TRAFIC 1.9DCI/VW: TRANSPORTER 2.5TDI)*
Bu şekilde ihtiyacım olan ve olmayan ürün grubu aynı satırda yer alınca kilitleniyorum.


Not: Asıl dosya 85000 satır içerdiği için örnek oluşturması adına bin satırlık dosya ekledim.
 

Ekli dosyalar

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,647
Excel Vers. ve Dili
Pro Plus 2021
Sayfa2 'yi oluşturun. Oraya filtreleyecek.
Silinecekler listesine FIAT-CITROEN-PEUGEOT grup olarak ekledim.

Kod:
Sub filtrele()
    Set adoCN = CreateObject("ADODB.Connection")
    adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCN.Properties("Data Source") = ThisWorkbook.FullName
    adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    adoCN.Open
    Set rs = CreateObject("Adodb.RecordSet")


    strSQL = "SELECT * FROM [Sayfa1$] WHERE " & _
             " NOT GRUP_ISIM IN ('FIAT-CITROEN-PEUGEOT','ALFA ROMEO','AUDI','BMC','BMW','CHRYSLER','CHEVROLET','CITROEN', " & _
             "'DAEWOO','DAF','DFM','DODGE','FARGO','FIAT','FORD','GELLY','HINO','ISUZU','IVECO', " & _
             "'JAGUAR','JEEP','JOHN DEERE','KARSAN','LADA','LANCIA','LAND ROVER','LDV','LEXUS','MAGIRUS', " & _
             "'MAN','MERCEDES','MINICOOPER','OPEL','PEUGEOT','PORSCHE','ROVER','SAAB','SAMSUNG','SEAT', " & _
             "'SKODA','SMART','SSANGYONG','SUBARU','TATA','VOLKSWAGEN','VOLVO','YAMAHA','VW')" & _
             " OR " & _
             "(" & _
             " STOK_ADI LIKE '%DACIA%' OR" & _
             " STOK_ADI LIKE '%HONDA%' OR" & _
             " STOK_ADI LIKE '%HYUNDAI%' OR" & _
             " STOK_ADI LIKE '%KIA%' OR" & _
             " STOK_ADI LIKE '%MAZDA%' OR" & _
             " STOK_ADI LIKE '%MITSUBISHI%' OR" & _
             " STOK_ADI LIKE '%NISSAN%' OR" & _
             " STOK_ADI LIKE '%PROTON%' OR" & _
             " STOK_ADI LIKE '%RENAULT%' OR" & _
             " STOK_ADI LIKE '%SUZUKI%' OR" & _
             " STOK_ADI LIKE '%TOYOTA%' " & _
             ")"

    rs.Open strSQL, adoCN, 1, 1
    Sheets("Sayfa2").Cells.ClearContents
    For Each f In rs.Fields
        i = i + 1
        Sheets("Sayfa2").Cells(1, i).Font.Bold = True
        Sheets("Sayfa2").Cells(1, i) = f.Name
    Next
    Sheets("Sayfa2").Cells(2, 1).CopyFromRecordset rs
    Sheets("Sayfa2").Columns.AutoFit
    rs.Close
    adoCN.Close
    Set rs = Nothing
    Set adoCN = Nothing
End Sub
 

ÆSir

Dora
Altın Üye
Katılım
15 Ocak 2018
Mesajlar
225
Excel Vers. ve Dili
2015 TR
Altın Üyelik Bitiş Tarihi
20-05-2025
Harika çalıştı, nasıl teşekkür ederim bilemiyorum.
 
Katılım
19 Haziran 2017
Mesajlar
216
Excel Vers. ve Dili
365
Altın Üyelik Bitiş Tarihi
05-04-2024
Sayfa2 'yi oluşturun. Oraya filtreleyecek.
Silinecekler listesine FIAT-CITROEN-PEUGEOT grup olarak ekledim.

Kod:
Sub filtrele()
    Set adoCN = CreateObject("ADODB.Connection")
    adoCN.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCN.Properties("Data Source") = ThisWorkbook.FullName
    adoCN.Properties("Extended Properties") = "Excel 12.0; HDR=Yes"
    adoCN.Open
    Set rs = CreateObject("Adodb.RecordSet")


    strSQL = "SELECT * FROM [Sayfa1$] WHERE " & _
             " NOT GRUP_ISIM IN ('FIAT-CITROEN-PEUGEOT','ALFA ROMEO','AUDI','BMC','BMW','CHRYSLER','CHEVROLET','CITROEN', " & _
             "'DAEWOO','DAF','DFM','DODGE','FARGO','FIAT','FORD','GELLY','HINO','ISUZU','IVECO', " & _
             "'JAGUAR','JEEP','JOHN DEERE','KARSAN','LADA','LANCIA','LAND ROVER','LDV','LEXUS','MAGIRUS', " & _
             "'MAN','MERCEDES','MINICOOPER','OPEL','PEUGEOT','PORSCHE','ROVER','SAAB','SAMSUNG','SEAT', " & _
             "'SKODA','SMART','SSANGYONG','SUBARU','TATA','VOLKSWAGEN','VOLVO','YAMAHA','VW')" & _
             " OR " & _
             "(" & _
             " STOK_ADI LIKE '%DACIA%' OR" & _
             " STOK_ADI LIKE '%HONDA%' OR" & _
             " STOK_ADI LIKE '%HYUNDAI%' OR" & _
             " STOK_ADI LIKE '%KIA%' OR" & _
             " STOK_ADI LIKE '%MAZDA%' OR" & _
             " STOK_ADI LIKE '%MITSUBISHI%' OR" & _
             " STOK_ADI LIKE '%NISSAN%' OR" & _
             " STOK_ADI LIKE '%PROTON%' OR" & _
             " STOK_ADI LIKE '%RENAULT%' OR" & _
             " STOK_ADI LIKE '%SUZUKI%' OR" & _
             " STOK_ADI LIKE '%TOYOTA%' " & _
             ")"

    rs.Open strSQL, adoCN, 1, 1
    Sheets("Sayfa2").Cells.ClearContents
    For Each f In rs.Fields
        i = i + 1
        Sheets("Sayfa2").Cells(1, i).Font.Bold = True
        Sheets("Sayfa2").Cells(1, i) = f.Name
    Next
    Sheets("Sayfa2").Cells(2, 1).CopyFromRecordset rs
    Sheets("Sayfa2").Columns.AutoFit
    rs.Close
    adoCN.Close
    Set rs = Nothing
    Set adoCN = Nothing
End Sub
Hocam Merhaba, bu çalışmaya benzer bir durumum var.

https://www.excel.web.tr/threads/toplu-filtrele-yapmak-veya-silmek.189172/ konusunda da yardımcı olabilir misiniz rica etsem?

Çok teşekkür ederim, saygılarımla.
 
Üst