Koşul belirtilen satırların dışındakiler silinsin.

[firefox_37]

Hayırlı Günler..

Elimde bir fiyat tarihçesi var. Tabi mükerrer satırlarlar da var sayfada.
Yapmam gereken mükerrer satırları bulup en yüksek fiyatlı olan satırı bırakıp diğer satırları silmesi..
Bunu yapabilir miyiz..

Dosyam ektedir.


İyi çalışmalar.

 

[Ömer]

Merhaba,

Hangi sütuna göre mükerrer değerlere bakılacak. Ayırca eklediğiniz dosyaların 2003 formatında olmasına özen gösteriniz.

.

 

[firefox_37]

Özür dilerim aslında dikkat ediyorum ama bu gözden kaçmış..

"Part No" sütununa göre mükkerrer değerlere bakılacak.

 

[Ömer]

Merhaba,

Module kopyalayarak çalıştırın.

Option Explicit
 
Sub BulSil()
Dim i, k, son As Long
Application.ScreenUpdating = False
son = [A65536].End(3).Row
    For i = 2 To son
        Cells(i, "G").Formula = "=COUNTIF(A2:A" & son & " ," & "A" & i & " )"
        Cells(i, "H").FormulaArray = "=IF(" & "G" & i & "=1,"""",IF(ROW()=MAX(IF(A2:A" _
        & son & "=A" & i & " ,ROW(D2:D" & son & "))),""Sil"",""""))"
    Next i
    For k = son To 2 Step -1
        If Cells(k, "H") = "Sil" Then
            Rows(k).Delete
        End If
    Next k
Range("G:H").ClearContents
Application.ScreenUpdating = True
End Sub

.

 

[firefox_37]

Her zaman ki gibi yine vermiş olduğunuz kod sorunsuz çalışıyor..

Teşekkürler ..

 

[firefox_37]

Tekrar Merhaba Ömer Bey.

Ekteki dosyada vermiş olduğunuz kodu uyguluyorum..
Mükerrer kayıtları silme işlemini yapıyor fakat;

Fiyatı en yüksek olan satırı değil sıralamada ilk sırada olanı bırakıyor diğer satırları siliyor.
Benim istediğim fiyatı en yüksek olan satır kalsın diğerlerini silsin..

İlginiz için şimdiden teşekkür eder..
Çalışmalarınızda başarılar dilerim.

 

[firefox_37]

Dosya ektedir

 

[Ömer]

Kod da MAK olan bölgeyi MIN yaparak deneyin.

.

 

[firefox_37]

Tekrar Merhaba Ömer Bey;

Dediğiniz gibi yapıp koddaki MAX olan kısmı MIN yaptım.. Fakat problem devam ediyor.
a 10
b 10
c 10
a 12
b 12
c 12
a 10
b 10
c 10
mesela bu örnekte bırakması gerekenler tutarı 12 olanlardır..Fakat en alttaki ne ise onu bırakıyor koda göre..

Örnek dosyam ektedir.

 

[Ömer]

Sayın firefox_37,

Konunun üzerinden 1 ay gibi bir zaman geçtiği için ne yapılması gerektiğini hatırlamıyorum. Yeni bir tablo ekleyerek silinmesini istediğiniz satırların karşına sil yazarak nedenlerini detaylı açıklayınız.

.

 

[firefox_37]

Yeni tabloyu oluşturdum ve silinmesi gereken satırları belirttim

Nedeni ise yurtdışına proforma fatura düzenliyoruz..
Bir müşteriye birden fazla proforma fatura gönderiyoruz ve yeni bir proforma düzenlemek istediğimde daha önceden kesilmiş tüm proforma fatura satırlarını bir dosyada toplayıp inceliyorum.

Fakat bir stoktan 3 faturada satış yaptıysam en son oluşturduğum dosyada da 3 satır olarak yer kaplıyor ayrı yerlerde..
Ben hem mükerrerliği önlemek hemde en yüksek fiyatlı olan stok satırını bulmak istiyorum.

Şuan ki kod mükerrerliği götürüyor fakat en yüksek fiyatlı satırı bırakmıyor.
Umarım açıklayıcı olmuşumdur..

Teşekkürler..

 

[Ömer]

Bu şekilde deneyin.

Option Explicit
 
Sub BulSil()
On Error Resume Next
Dim i, k, son, yson, j As Long
Application.ScreenUpdating = False
son = [A65536].End(3).Row
    For i = 2 To son
        Cells(i, "H").FormulaArray = "=IF(MAX(IF(A2:A" & son & "=A" _
        & i & " ,D2:D" & son & "))<>D" & i & "  ,""Sil"","""")"
    Next i
    For k = son To 2 Step -1
        If Cells(k, "H") = "Sil" Then
            Rows(k).Delete
        End If
    Next k
Range("H:H").ClearContents
yson = [A65536].End(3).Row
Range("A1:D" & yson).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    For j = yson To 1 Step -1
        If Rows(j).Hidden Then Rows(j).Delete
    Next j
ActiveSheet.ShowAllData
Application.ScreenUpdating = True
End Sub