Saatler arası fark alan makro

[ergunarat]

Merhaba Makro üstadları

ekteki excel dosyasında isisim ve işlem kayıtları mevcuttur. İstediğim makro ise başka bir sayfada isimlere göre kayıt saatlerini sıralamak ve iki kayıt saati arasındaki süre 5 dk geçiyorsa bu fark sürelerini toplamak.

Konu hakkında yardımlarınızı bekliyorum.

 

[ergunarat]

Bir fikri olan yok mu?

 

[Husgvarna]

Şöyle deneyin.

Private Sub CommandButton1_Click()
[b2:g6] = Empty
Sheets("Sayfa3").Range("a1:a" & Sheets("Saat").Cells(65000, 1).End(xlUp).Row).Value = _
Sheets("Saat").Range("e1:e" & Sheets("Saat").Cells(65000, 1).End(xlUp).Row).Value
Sheets("Sayfa3").Range("b1:b" & Sheets("Saat").Cells(65000, 1).End(xlUp).Row).Value = _
Sheets("Saat").Range("j1:j" & Sheets("Saat").Cells(65000, 1).End(xlUp).Row).Value
Sheets("Sayfa3").Range("a2:b65000").Sort Key1:=Sheets("Sayfa3").Range("b2")
For a = 2 To Range("b1").End(xlToRight).Column
Set cc = Sheets("Sayfa3").Range("b1:b65000").Find(Cells(1, a), LookIn:=xlValues)
If Not cc Is Nothing Then b = cc.Row
n = 0
h = WorksheetFunction.CountIf(Sheets("Sayfa3").Range("b2:b65000"), Cells(1, a))
Sheets("Sayfa3").Range("a" & b & ":b" & b + h - 1).Sort Key1:=Sheets("Sayfa3").Range("a" & b)
For c = b To b + h - 1
If Cells(2, a) = "" Then Cells(2, a).Value = Sheets("Sayfa3").Cells(b, 1).Value
If Sheets("Sayfa3").Cells(c, 2) = Sheets("Sayfa3").Cells(c + 1, 2) Then
If DateDiff("n", Sheets("Sayfa3").Cells(c, 1), Sheets("Sayfa3").Cells(c + 1, 1)) > 5 Then
n = DateDiff("n", Sheets("Sayfa3").Cells(c, 1), Sheets("Sayfa3").Cells(c + 1, 1)) + n
Cells(5, a) = DateAdd("n", n, "00:00:00")
End If
End If
If c = b + h - 1 Then Cells(3, a).Value = Sheets("Sayfa3").Cells(c, 1).Value
Next
If Cells(2, a) < Cells(3, a) Then s = DateDiff("n", Cells(2, a), Cells(3, a))
If Cells(2, a) > Cells(3, a) Then s = DateDiff("n", Cells(3, a), Cells(2, a))
Cells(4, a) = DateAdd("n", s, "00:00:00")
If Cells(4, a) < Cells(5, a) Then x = DateDiff("n", Cells(4, a), Cells(5, a))
If Cells(4, a) > Cells(5, a) Then x = DateDiff("n", Cells(5, a), Cells(4, a))
Cells(6, a) = DateAdd("n", x, "00:00:00")
Next
Sheets("Sayfa3").[a1:b65000] = Empty
End Sub

 

[ergunarat]

Merhaba

Ek dosyayı inceleyin.

Elineze sağlık hocam. Kısa ve öz olmuş. Ancak liste her zaman sıralı olmuyor. Bazen saat sırası farklı karışık olabiliyor. Saat sırası karışık olduğunda makro hata vermektedir.

Burada max ve min olarak nasıl değiştirebiliriz. Birde rapor kolonları her versiyonda ekleme ve çıkarma yapılmaktadır. Makroda değişmesi gerekmektedir. Buraki kısa yolu yoluda anlatırmısınız.

 

[ergunarat]

Sorun devam ediyor.

Husgvarna ; Sorun devam ediyor.

Elineze sağlık hocam. Kısa ve öz olmuş. Ancak liste her zaman sıralı olmuyor. Bazen saat sırası farklı karışık olabiliyor. Saat sırası karışık olduğunda makro hata vermektedir.

Burada max ve min olarak nasıl değiştirebiliriz. Birde rapor kolonları her versiyonda ekleme ve çıkarma yapılmaktadır. Makroda değişmesi gerekmektedir. Buraki kısa yolu yoluda anlatırmısınız.

 

[Husgvarna]

Husgvarna; Sorun devam ediyor.

Merhaba.
Sayın ergunarat,
Saat sütununu sıralatarak olabilir.

 

[ergunarat]

Merhaba.
Sayın ergunarat,
Saat sütununu sıralatarak olabilir.

Maalesef olmadı. makro bazı hatalar var. Doğru sonuç vermiyor.

 

[ergunarat]

Ya arkadaşlar hiç yardımcı olacak biri yok mu?

 

[Husgvarna]

Yukarıdaki değişen kodları inceleyin.
Veriler "sayfa3" e alınıp sıralama yaptırılır.

 

[ergunarat]

Teşekkür ederim. Sanırım bu kez oldu.