aynı tarih içindeki başlama ve bitiş saat farkı

[gezgin-49]

Sayın üstadlarım, D sütununda yaklaşık 80.000 tana tarih var, bu tarihlerin hemen hepsi birden fazla olup, farklı saatleri içermektedir, sorum şu: aynı tarihin başlangıç saati ile bitiş saati arasındaki farkı nasıl bulurum,

aynı tarihe ait aradaki saatler hesap dışı olacak, yani sadece aynı tarihin ilk ve son saatleri arasındaki fark lazım.
aşağıda küçük bir örnek var. Saygılarımla

4.01.2016 07:28​

4.01.2016 07:29​

4.01.2016 07:30​

4.01.2016 15:31​

4.01.2016 17:31​

5.01.2016 07:45​

5.01.2016 07:46​

5.01.2016 07:47​

5.01.2016 07:50​

6.01.2016 07:45​

6.01.2016 15:51​

6.01.2016 19:51​

 

[gezgin-49]

örnek bir dosya gönderiyorum.

Bilgi

Bilgi

dosyam.org

 

[Korhan Ayhan]

Bu kadar satır için formüllü çözüm dosyayı kasabilir.

 

[gezgin-49]

Sayın üstadım kod ile çözülebilir mi acaba?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sure_Hesapla()
    Dim Dizi As Object, S1 As Worksheet, Zaman As Double
    Dim Veri As Variant, X As Long, Say As Long, Son As Long
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    S1.Range("G3:G" & S1.Rows.Count).ClearContents
    
    Son = S1.Cells(S1.Rows.Count, "D").End(3).Row
    If Son = 3 Then Son = 4
    
    Veri = S1.Range("D3:D" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 2)
    
    For X = LBound(Veri) To UBound(Veri)
        If Not Dizi.Exists(Format(Veri(X, 1), "dd.mm.yyyy")) Then
            Say = Say + 1
            Dizi.Add Format(Veri(X, 1), "dd.mm.yyyy"), Say
            Liste(Say, 1) = Veri(X, 1)
            Liste(Say, 2) = Veri(X, 1)
        Else
            If Veri(X, 1) < Liste(Dizi.Item(Format(Veri(X, 1), "dd.mm.yyyy")), 1) Then
                Liste(Dizi.Item(Format(Veri(X, 1), "dd.mm.yyyy")), 1) = Veri(X, 1)
            End If
            If Veri(X, 1) > Liste(Dizi.Item(Format(Veri(X, 1), "dd.mm.yyyy")), 2) Then
                Liste(Dizi.Item(Format(Veri(X, 1), "dd.mm.yyyy")), 2) = Veri(X, 1)
            End If
        End If
    Next
    
    Son = S1.Cells(S1.Rows.Count, "F").End(3).Row
    If Son = 3 Then Son = 4
    
    Veri = S1.Range("F3:G" & Son).Value
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Dizi.Exists(Format(Veri(X, 1), "dd.mm.yyyy")) Then
            Veri(X, 2) = Liste(Dizi.Item(Format(Veri(X, 1), "dd.mm.yyyy")), 2) - Liste(Dizi.Item(Format(Veri(X, 1), "dd.mm.yyyy")), 1)
        Else
            Veri(X, 2) = ""
        End If
    Next
    
    S1.Range("F3").Resize(UBound(Veri, 1), UBound(Veri, 2)) = Veri
    S1.Range("G3").Resize(UBound(Veri, 1)).NumberFormat = "[$-F400]h:mm:ss AM/PM"

    Set S1 = Nothing
    Set Dizi = Nothing

    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[gezgin-49]

Sayın Üstadım Korhan Ayhan siz bir harikasınız, Allah sizden razı olsun, sizi iki cihanda aziz etsin inşallah.

 

[Korhan Ayhan]

Güzel dilekleriniz için çok teşekkür ederim. Bilmukabele..