• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

gezgin-49

Altın Üye
Katılım
17 Ekim 2006
Mesajlar
669
Excel Vers. ve Dili
Türkçe 2003
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
 
Bu kadar satır için formüllü çözüm dosyayı kasabilir.
 
Deneyiniz.

C++:
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
 
Sayın Üstadım Korhan Ayhan siz bir harikasınız, Allah sizden razı olsun, sizi iki cihanda aziz etsin inşallah.
 
Güzel dilekleriniz için çok teşekkür ederim. Bilmukabele..
 
Geri
Üst