Kriterler aynı ise en küçüğünü al filtresi

[energy3234]

Merhaba arkadaşlar,
daha önce bu konuda yardım almıştım ama şimdi çalıştıramadım.
ekte gönderiyorum dosyayı...
6 sütun ve bir çok satırdan ibaret bir tablom var, içerisinde 5 sütunda tekrar eden kayıtlar var bunların aynı isimli aynı soyisimli aynı numaralı ve aynı tarihli kayıtlardan saat sütunundaki en küçük saatli sütunun kalmasını diğerlerinin silinmesini istiyorum.
ekte dosyada makroyu yine buradaki üstadlardan yardım alarak çalıştırmıştım ama şimdi çalışmıyor

 

[energy3234]

Konuyu açarken kodları göndermemişim

kodu göndermemişim düzeltiyorum.
Konuyu açarken kodları göndermemişim kusura bakmayın...

yardımcı olursanız sevinirim.
doğru dosya ektedir.

 

[energy3234]

yardımcı olacak bir arkadaş bekliyorum...
belirttiğim sıkıntı basit gibi ama bulamadım... lütfen yardımcı olursanız sevinirim.

 

[energy3234]

Sub benzersiz_min()
Dim z, sat As Long, a(), n As Long, myarr(), deg As String, i As Long
Set z = CreateObject("Scripting.Dictionary")
sat = Cells(65536, "B").End(xlUp).Row
ReDim myarr(1 To 9, 1 To sat)
a = Range("A1:I" & sat).Value
For i = 1 To UBound(a, 1)
deg = a(i, 1) & a(i, 2) & a(i, 5) & a(i, 6)
If Not z.exists(deg) Then
n = n + 1
z.Add deg, n

End If
myarr(2, z.Item(deg)) = a(i, 1)
myarr(3, z.Item(deg)) = a(i, 2)
myarr(4, z.Item(deg)) = a(i, 3)
myarr(5, z.Item(deg)) = a(i, 4)

If myarr(6, z.Item(deg)) = "" Then
myarr(6, z.Item(deg)) = a(i, 5)
ElseIf a(i, 5) < myarr(6, z.Item(deg)) Then
myarr(6, z.Item(deg)) = a(i, 5)

End If

Next
Application.ScreenUpdating = False
Range("A1:I65536").ClearContents
Range("A1").Resize(n, 9) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "Teke indirme yapıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKCancel + vbInformation, "E V R E N"

End Sub

kullandığım makro bu ama tekrar eden satırlardan 6.(F)sütundaki zamanın en küçük olduğu sütunu alamıyorum.
yardımlarınızı bekliyorum.