Tarihte ilk ve son

[Morphe]

Merhaba Arkadaşlar,

Elimdeki dökümanda tarihler ve yanlarında saatler var. Başlangıç ve bitiş tarih ve saatlerini alıp arada kalan saatleri silmek istiyorum. Bunu nasıl yapabilirim?

A sutununun formatı: gg.aa.yyyy ss:dd

21.11.2014 13:50 CIKIS Misafir-1
21.11.2014 14:03 CIKIS Misafir-1
21.11.2014 14:23 CIKIS Misafir-1
21.11.2014 16:40 CIKIS Misafir-1
21.11.2014 17:42 CIKIS Misafir-1
21.11.2014 17:53 CIKIS Misafir-1

 

[OoParadiSeoO]

Aşağıdaki kodları yeni bir modüle ekleyiniz.

Sub sil()
Range("A2:B" & [A65536].End(3).Row - 1).Delete
MsgBox "İşlem Tamamlandı."
End Sub

 

[Morphe]

Hocam ilgin için teşekkür ederim fakat benim istediğim aşağıda 13:50 ve 17:53 kalacak arasındaki saatler silincek.

21.11.2014 13:50
21.11.2014 14:03
21.11.2014 14:23
21.11.2014 16:40
21.11.2014 17:42
21.11.2014 17:53

 

[Emir Hüseyin Çoban]

. . .

Listede tek bir gün için mi kayıtlar var.
Örnek dosya yüklerseniz daha net çözümler üretilebilir.

. . .

 

[Morphe]

Hayır Kasım ayı mesela... Örnek dosyayı buradan yükleyemedim Speedy ile gönderdim.

http://speedy.sh/X3Rha/Cikis-Full.xls

 

[Morphe]

Bu konuda yardımcı olabilecek var mı?

 

[Emir Hüseyin Çoban]

. . .

D sütunu yardımcı alan olarak kullanmıştır.

Sub KOD()
    Application.ScreenUpdating = False
    
    Dim ilk As Currency: Dim ilk2 As Currency
    Dim son As Currency: Dim son2 As Currency
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        Cells(i, "D") = Format(Cells(i, "A"), "dd.mm.yyyy")
    Next i
    
    sonsat = Cells(Rows.Count, "A").End(3).Row
    For s = sonsat To 2 Step -1
        ilk = Evaluate("=MIN(IF(D2:D" & sonsat & "=D" & s & ",A2:A" & sonsat & "))")
        son = Evaluate("=MAX(IF(D2:D" & sonsat & "=D" & s & ",A2:A" & sonsat & "))")
        ilk2 = Cells(s, "A").Value
        son2 = Cells(s, "A").Value
        
        If ilk2 <> ilk And Cells(s, "B") = "GIRIS" Or _
            son2 <> son And Cells(s, "B") = "CIKIS" Then
            Rows(s).Delete
        End If
        
    Next s
    Range("D:D").ClearContents
    
    Application.ScreenUpdating = True
    MsgBox "B i t t i "
End Sub

. . .