Soru Mükerer satırların silinip ,küçük tarihli satırınların küçükten büyüge sıralanması.

[emrebenn]

Merhaba
Ekteki örnek dosyamda aşağıdaki kodu kullanıp mükerer satırları silip.
En küçük tarihli satırdan başlayarak satırları sıralamak istiyorum.
Fakat bazı satırlar silinirken bazı mükerer satırlar silinmiyor.

Tam olarak yapmak istedigim tarih stünün daki tarihi dikkate almadan satırları bire düşürmek en sonda kalan satır en küçük tarih olmasını ve bunu küçükten büyüge doğru sıralamak istiyorum.

İndir Örnek

Dosyayı indir Örnek

dosya.co

Sub mukerrer_sil()

Dim son As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

son = Cells(Rows.Count, "A").End(xldown).Row
Range("A2:G" & son).Sort Key1:=Range("A2"), Order1:=xlDescending
Range("A2:G" & son).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[YUSUF44]

Anladığım kadarıyla makro kaydet yöntemiyle elde edip düzenlediğim aşağıdaki makroyu deneyiniz. En küçük tarihli satırın kalması için öncelikle tarihe göre sıralama yapılması gerekmektedir:

Sub tekleme()
    son = Cells(Rows.Count, "A").End(3).Row
    Range("A10").Select
    ActiveWorkbook.Worksheets("Bütün Projeler").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Bütün Projeler").Sort.SortFields.Add Key:=Range( _
        "A10:A" & son), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("Bütün Projeler").Sort
        .SetRange Range("A2:G" & son)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$G$" & son).RemoveDuplicates Columns:=Array(2, 3, 4, 5, 6, 7) _
        , Header:=xlYes
End Sub

 

[emrebenn]

İşe yarıyor ama asıl kulladığım dosyada Yüzlerce satır olacak o dasyada canlı bir dosya veriler sürekli girilip tarihler degişecek.
Yazdığınız kodlama da şu bölüm için kafada soru işeri oluştu.
Paylaştığım dosyadaki verilere özel yazılmış gibi duruyor.Eğer böyle ise bana daha kapsayıcı bir kodlama gerekli.Bu arada emeğiniz için teşekkür ederim.

Range("A10").Select
ActiveWorkbook.Worksheets("Bütün Projeler").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Bütün Projeler").Sort.SortFields.Add Key:=Range( _
"A10:A" & son), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortTextAsNumbers

 

[YUSUF44]

Verdiğim kodlar dosyanıza özel olsa da dosyanızda alt satırlara ilave ettiğinizde yada satır sildiğinizde de çalışır. Çünkü son dolu satıra göre işlem yapmaktadır. 100 satır varsa 100 satır, 150000 satır varsa 150000 satır için işlem yapar. (Range("A10").select satırını silebilirsiniz, makro kaydetten kalmış, makroda bir fonksiyonu yok)