Macro yardımıyla şartlı silme

[levoni]

Değerli hocalarım merhabalar,
Günlük işlemlerimde kullandığım ama çok yapması uzun zaman alan bir konu hakkında sizin değerli yardımlarınıza ihtiyacım var.
Şöyleki;
ekteki excelde K sütunundaki E sütunundaki aynı değerleri olan satırlardan D sütunundaki Kapama Tarihi alanındaki en büyük tarih ve saat in altında kalan bütün satırı macro yardımı ile silmek istiyorum.
Ekteki örnekte örnek olarak sarı ile işaretlediğim kayıtlardan mavi olan satır haricide sarı satırların komple silinmesi gerekiyor.

Bu konuda yardımcı olabilirseniz gerçekten çok memnun olurum.Normalde şuan az gibi görünüyor ancak ben az örnek koydum.
Teşekkürler

 

[Korhan Ayhan]

Merhaba,

Örnek dosyanıza göre 180141004 nolu koda sahip satırları dolgusuz bırakmışsınız. Bu koda ait satırlar silinmeyecek mi? Silinmeyecekse sebebi nedir?

 

[levoni]

Korhan Bey merhaba,
öncelikle cevap verip ilgilendiğiniz için çok teşekkür ederim.

Dolgu yaptığım satırları örnek olsun ve daha rahat göze gözüksün diye yapmıştım.Dolayısıyla ilgili koda ve aynı özellikte olan satırlar da silinmesi gerekiyor.

 

[Korhan Ayhan]

Merhaba,

Dosyanızın yedeğini alıp aşağıdaki kodu denermisiniz.

Sub KOŞULLU_SİL()
    Dim Son As Long, Formül As String, Hücre As Range
        
    Application.ScreenUpdating = False
    
    Son = Cells(Rows.Count, "K").End(3).Row
    Formül = "=IF(AND(SUMPRODUCT((E$2:E$1048576=E2)*(K$2:K$1048576=K2))>1,D2<SUMPRODUCT(MAX((E$2:E$1048576=E2)*(K$2:K$1048576=K2)*(D$2:D$1048576)))),""SİLİNECEK"","""")"
    Formül = Replace(Formül, 1048576, Son)
    
    With Range("AA2:AA" & Son)
        .Formula = Formül
        .Value = .Value
    End With
    
    Range("AA:AA").AutoFilter Field:=1, Criteria1:="<>"
    On Error Resume Next
    Set Hücre = Range("AA2:AA" & Son).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not Hücre Is Nothing Then Hücre.EntireRow.Delete
    Range("AA:AA").Clear
    Set Hücre = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[levoni]

Sayın Korhan Bey Merhaba,

Pc ye yeni bakabildim bu yüzden mesajınıza çok geç dönüş yapıyorum özür dilerim.
Macro için çok teşekkür ederim.Elinize sağlık eksik olmayın

İyi geceler

 

[bombjack]

Arkadaşlar merhaba.

Forum içindeki aramalarıma rağmen döngü içinde sumproduct fonksiyonunu kullanmayı yapamadım. Örnek dosya ektedir.

Yardımlarınızı bekliyorum.

Teşekkürler.