Koşullu Silme

[cimcoz]

Merhaba,
Bu isteyeceğim şeyi forumda bulamadığım için (en azından benzerini) yeni konu açtım, kusura bakmayın.

İsteğim şu:

Ekteki dosyada bulunan J1,J2,.... hücrelerine yazılı veya yazılacak isimlerin bulunduğu satırları A-G arasını kapsayacak şekilde sildirmek istiyorum.
Örneğin:
J2'de bulunan ALI YILMAZ'ın geçtiği satırların;

2259 ALI YILMAZ 11.12.2008 09:12 00:00:30 Outgoing 807 12345678

gibi olanların A-G arasında silinmesi sağlayan bir fonksiyon veya macro konusunda yardımcı olursanız sevinirim.

Teşekkürler.

Cimcoz

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları, standart bir module'ün içine kopyalarak çalıştırınız.

Sub Coklu_Kritere_Gore_Sil()
    Dim x As Integer
    Dim b As Integer
    Dim iSonJ As Integer
    Dim iSonB As Integer
    Dim rngKrt As Range
    Dim rng As Range
    Dim rngSil As Range
    
    iSonJ = Cells(65536, "J").End(xlUp).Row
    iSonB = Cells(65536, "B").End(xlUp).Row
    
    If iSonJ < 2 Or iSonB < 2 Then
        MsgBox "Silme kriteri girmediniz veya Tabloda hiç veri yok", vbCritical, "Uyarı"
        Exit Sub
    End If
    
    Set rngKrt = Range("J2:J" & iSonJ)
    
    For b = 2 To iSonB
        Set rng = rngKrt.Find(Cells(b, "B"), Lookat:=xlWhole)
        If Not rng Is Nothing Then
            x = x + 1
            If x = 1 Then
                Set rngSil = Range("A" & b & ":G" & b)
            Else
                Set rngSil = Application.Union(rngSil, Range("A" & b & ":G" & b))
            End If
        End If
    Next b
    
    If Not rngSil Is Nothing Then
        With Application
            .Calculation = xlCalculationManual
            rngSil.ClearContents
            .Calculation = xlCalculationAutomatic
        End With
    Else
        MsgBox "Silinecek bir kayıt bulunamadı", vbInformation, "Bilgilendirme"
    End If
    
    Set rng = Nothing
    Set rngKrt = Nothing
    Set rngSil = Nothing
End Sub

 

[cimcoz]

Sayın Pazarçevirdi,
İnanın son 10 günde iki farklı isteğimi süper hızlı ve tamamen çözdünüz.
Çok teşekkür ederim.

Cimcoz