Benzersiz Verileri Sondan İtibaren Sıralamak

[Ergün Güler]

Selam,
Örnek dosyamda, Fonksiyonlar ile 3 sütundaki bilgileri O sütununda birleştirerek listeliyorum. P sütununda ise O sütununda benzer olmayanlara 1'den itibarern Birer birer artan no. veriyorum. P sütunundaki en son no.ya ait satır bilgilerinden başlayarak başka bir sayfada ilk 3 tanesini listeliyorum.

Örnek P sütunundaki son sayısal değer 47 dir (163.satır)
bir önceki değer 46 (162.satır)
ondan bir önceki 45 (154.satır)

İste ben aşağıdaki sırayla (sondan ilk 3 tanesini)
163.satır
162.satır
154.satır'ın gerekli bilgilerini listeliyorum.

Fonksiyonlar ile yaptığım çalışmayı makro ile For-Next döngüleriyle yapmaya çalıştım. Ancak, 2 tane yardımcı sütun kullanmadan yapamadım.
Makro ile yardımcı hücre olmadan nasıl yapabilirim?

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub vba_ile_benzersiz_topla_aktar_Son3_kayit_59()
Dim sh As Worksheet, sat As Long, z As Object, n As Long
Dim liste(), myarr(), i As Long, deg As String, say As Byte, k As Byte
Sheets("SON-Çeşitler").Select
Set sh = Sheets("insört")
sat = sh.Cells(65536, "G").End(xlUp).Row
Range("A6:G65536").ClearContents
If sat < 3 Then Exit Sub
liste = sh.Range("A3:J" & sat).Value
ReDim myarr(1 To 7, 1 To 65536)
Set z = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(liste, 1)
    deg = liste(i, 7) & "-" & liste(i, 9) & "-" & liste(i, 10)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = n
        myarr(2, n) = liste(i, 1)
        myarr(3, n) = liste(i, 2)
        myarr(4, n) = liste(i, 5)
        myarr(5, n) = liste(i, 7)
        myarr(6, n) = liste(i, 9)
        myarr(7, n) = liste(i, 10)
    End If
Next i
Application.ScreenUpdating = False
Set z = Nothing
ReDim Preserve myarr(1 To 7, 1 To n)
say = say + 1
For i = UBound(myarr, 2) To 1 Step -1
    For k = 1 To 7
        Cells(say + 5, k) = myarr(k, i)
    Next k
    say = say + 1
    If say = 4 Then Exit For
Next i
Erase myarr
Application.ScreenUpdating = True
MsgBox "VBA ile Benzersiz kayıtlar alındı ve son 3 kayit listelendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[Ergün Güler]

Selam,
Sayın Evren Gizlen. Gerçekten Mükemmel olmuş. Çok emeğiniz geçiyor. Çok teşekkür ederim.
İyi çalışmalar.
Sayenizde,
ReDim
myarr
Scripting.Dictionary
UBound
exists
öğreneceğiz inşallah.
İyi çalışmalar.

 

[Orion1]

Selam,
Sayın Evren Gizlen. Gerçekten Mükemmel olmuş. Çok emeğiniz geçiyor. Çok teşekkür ederim.
İyi çalışmalar.
Sayenizde,
ReDim
myarr
Scripting.Dictionary
UBound
exists
öğreneceğiz inşallah.
İyi çalışmalar.

Rica ederim.
İyi çalışmalar.