4 sütun aynı ise 5.sütundaki en küçük veriyi bulma

[energy3234]

Arkadaşlar yapmak istediğim olay, personel takip listesinden her personelin gün gün en erken hangi saatlerde iş yerine gelmiş.
Bunu ekteki excel dosyasında örneklemeye çalıştım yardımcı olan olursa sevinirim.

Not: Kart No, Ad,Soyad,Tarih aynı ise Saati en küçük olan veriye ulaşmak istiyorum. Aynı gün içindeki diğer veriler silinsin.
Bunu nasıl yapabilirim.

Not: başlık 4 sütun olacaktı 4.sütun yanlışlıkla yazmışım afedersiniz.

 

[Ömer]

Merhaba,

Bu şekilde deneyin. İstediğiniz veriler Sayfa2'ye listelenecektir.

Sub Bensersiz_Min()
 
    Dim d, s, a1, a2, deg, i As Long, dizi, j As Byte
    Dim S1 As Worksheet, S2 As Worksheet
 
    Set d = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    Application.ScreenUpdating = False
    S1.Select
    Range("A2:E" & Rows.Count).Sort Key1:=Range("A2"), Key2:=Range("D2"), _
                                    Key3:=Range("E2"), Order3:=xlAscending
 
    For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A") & "|" & Cells(i, "B") & "|" & Cells(i, "C") _
                & "|" & Cells(i, "D")
        If Not d.exists(deg) Then
            s = Cells(i, "E")
            d.Add deg, s
        End If
    Next i
 
    a1 = d.keys: a2 = d.items
 
    S2.Select
    Cells.Clear
    S1.Range("A1:E1").Copy Range("A1")
 
    For i = 0 To d.Count - 1
        dizi = Split(a1(i), "|")
        For j = 0 To UBound(dizi)
            Cells(i + 2, j + 1) = dizi(j)
        Next j
        s = a2(i)
        Cells(i + 2, "E") = s
    Next i
 
    Range("A2:E" & Rows.Count).Sort Key1:=Range("A2"), Key2:=Range("D2"), _
                                    Key3:=Range("E2")
 
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
 
End Sub

.