Birden fazla koşullu satır sil

[cnyttn]

Arkadaşlar merhaba,
Makroya yeni başladım, her yerde araştırmadan sormak istemedim kod yazmada yeni olduğum için basit kısımları kendim hallettim ama koşullu satır silme örneklerinde hep tek koşul üzerinden örnek kodlar buldum dosyada açıklamayı daha detaylı yaptım.

İstediğime gelecek olursak boş satır sil kodlarını yazıyorum ama koşulların değiştiği ve birden fazla olduğu durumda nasıl bir yol izlenmeli onu bulamadım. Yüklediğim dosyada iki örnek var. Örneklerde koşullarım değişebiliyor bunu kod içerisinde yazmak yerine ayrı bir sayfada yazılan metinleri (mesela Nakli Toplam, Mahsup fişi vb. alt alta hücrelere yazarsak ) asıl sayfada(sayfa ismini "düzenleme" olarak belirleyeceğim) bulup onların bulunduğu satırları silebileceğim bir yol arıyorum (metin kutusu, userform bunları tam bilmiyorum hangisi kullanabilecekse) yani kodun içerisinde tek koşul olmadan sonradan belirtebileceğimiz metinlerin olduğu satırlar silinecek.
yeni başladığım için normal excel formüllerine çok alışığım ama VBA başlangıçdayım henüz
şimdiden teşekkür ederim...

 

[cnyttn]

Yapmak istediğim işi aşağıdaki kod yapıyor ama yapamadığım kısım
1) bu kod tek tek bütün sütunlarda ayrı ayrı sorguluyor işlem uzuyor gibi geldi.
2) SatırSil diye bir sayfaya bir düğme atayıp ona atamak istiyorum ve düğmenin yanındaki E1 hücresi ve altına ne yazılırsa onu bulup silmesini istiyorum(koşullar değişebiliyor) örneğin "*Y E V M İ Y E D E F T E R İ*" "Yevmiye Defteri" olabiliyor,
3) bu kod sadece aktif kitapdaki Düzenleme isimli sayfada çalışmasını istiyorum
bu konuda yardımcı olursanız sevinirim, şimdiden teşekkür ederim.

Option Compare Text
 Sub SartliSil()
     Dim son As Long, deg, i As Long, _
     durum As Boolean, durum2 As Boolean, durum3 As Boolean, durum4 As Boolean, _
     durum5 As Boolean, durum6 As Boolean, durum7 As Boolean, durum8 As Boolean, _
     a As Integer, b As Integer, c As Integer, d As Integer, e As Integer, f As Integer, g As Integer, h As Integer
      
    son = Cells(Rows.Count, "A").End(xlUp).Row
    deg = Array("*Toplam*", "*Unvan*", "*Y E V M İ Y E   D E F T E R İ*", "*Kapanış Kaydı*")
     Application.ScreenUpdating = False
     For i = son To 1 Step -1
        durum = False
        For a = 0 To UBound(deg)
            If Cells(i, "A") Like deg(a) Then durum = True
            If durum = True Then Exit For
        Next a
        If durum = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum2 = False
        For b = 0 To UBound(deg)
            If Cells(i, "B") Like deg(b) Then durum2 = True
            If durum2 = True Then Exit For
        Next b
        If durum2 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum3 = False
        For c = 0 To UBound(deg)
            If Cells(i, "C") Like deg(c) Then durum3 = True
            If durum3 = True Then Exit For
        Next c
        If durum3 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum4 = False
        For d = 0 To UBound(deg)
            If Cells(i, "D") Like deg(d) Then durum4 = True
            If durum4 = True Then Exit For
        Next d
        If durum4 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum5 = False
        For e = 0 To UBound(deg)
            If Cells(i, "E") Like deg(e) Then durum5 = True
            If durum5 = True Then Exit For
        Next e
        If durum5 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum6 = False
        For f = 0 To UBound(deg)
            If Cells(i, "F") Like deg(f) Then durum6 = True
            If durum6 = True Then Exit For
        Next f
        If durum6 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum7 = False
        For g = 0 To UBound(deg)
            If Cells(i, "G") Like deg(g) Then durum7 = True
            If durum7 = True Then Exit For
        Next g
        If durum7 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    For i = son To 1 Step -1
        durum8 = False
        For h = 0 To UBound(deg)
            If Cells(i, "H") Like deg(h) Then durum8 = True
            If durum8 = True Then Exit For
        Next h
        If durum8 = True Then Rows(i).Delete Shift:=xlUp
    Next i
    Application.ScreenUpdating = True
 
End Sub

 

[PLİNT]

Merhaba
Yukarıdaki dosyanıza bakma imkanım yok ama 2. mesajdaki kodlarınız şöyle
düzenlenebilir
"deg" tanımlamasında isimleri artıracaksanız büyük harfle ve bitişik yazın,
kodlar; hücrelerde bulduğu verileri boşlukları kaldırıp, büyük harfe çevirerek karşılaştırılacaktır

[SIZE="2"]Sub SartliSil()
Dim b As Long, s As Long, son As Long, a As Long
Dim hcr As String, deg As Variant, s1 As Worksheet
Set s1 = Sheets("Düzenleme")
    son = s1.Cells(Rows.Count, "A").End(xlUp).Row
    [COLOR="Red"]deg = Array("TOPLAM", "UNVAN", "YEVMİYEDEFTERİ", "KAPANIŞKAYDI")[/COLOR]
For a = son To 1 Step -1
hcr = Empty
   For s = 1 To 8
   hcr = hcr & UCase(Replace(Replace(Replace(s1.Cells(a, s), "ı", "I"), "i", "İ"), " ", ""))
   Next: s = 0
For b = 0 To UBound(deg)
s = s + InStr(1, hcr, deg(b), vbTextCompare)
Next
  If s <> 0 Then s1.Rows(a).Delete Shift:=xlUp
Next
End Sub[/SIZE]

 

[cnyttn]

Merhaba
Yukarıdaki dosyanıza bakma imkanım yok ama 2. mesajdaki kodlarınız şöyle
düzenlenebilir
"deg" tanımlamasında isimleri artıracaksanız büyük harfle ve bitişik yazın,
kodlar; hücrelerde bulduğu verileri boşlukları kaldırıp, büyük harfe çevirerek karşılaştırılacaktır

Çok teşekkür ederim, çok hızlandı. Yeni başladığım için çoğu kodun tam özünü çözemiyorum o yüzden bulduklarımı kendime uyarlarken yolu uzatarak çözüm buluyorum. Sizin yazdıklarınızı araştırıp farklarını öğreneceğim. İlk dosyamda bununla ilgili zaten tek farkı ARRAY( içindeki aranacak kelimeleri kod içinde belirlemek yerine) ayrı bir Sayfa2 tanımlayıp orada koşulları A1:A10 aralığına ne yazılırsa onları S1.Düzenleme sayfasında bulup o satırın silmesini istiyorum çünkü koşullar artabiliyor.