DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Bu hariç formüller çalışıyor =DATE(YEAR(LEFT(B2,4)), MONTH(MID(B2,6,2)), DAY(MID(B2,9,2))), bunun sonucu 3.01.1905 geliyor.Merhaba,
F2 ye =TARİH(YIL(SOLDAN(B2;4)); AY(PARÇAAL(B2;6;2)); GÜN(PARÇAAL(B2;9;2))) ya da
=DATE(YEAR(LEFT(B2,4)), MONTH(MID(B2,6,2)), DAY(MID(B2,9,2)))
G2 ye =ZAMAN(PARÇAAL(B2;12;2)*1; PARÇAAL(B2;15;2)*1; PARÇAAL(B2;18;2)*1) ya da =TIME(MID(B2,12,2)*1, MID(B2,15,2)*1, MID(B2,18,2)*1)
Ayrıca sizin Excel de F2 ye =DATEVALUE(LEFT(B2,10)) ve G2 ye =TIMEVALUE(RIGHT(B2,8)) olur görünüyor, ama bunu deneyemedim.
İyi çalışmalar
Tabloda da açıkladım, kişi ve tarih bazında giriş çıkışlar arasındaki farkları hesaplayıp, gün içinde iş yerinde geçirilen süre hesaplanılıyor.Dosyanızda K sütunnda 88., 107., 128. satırlarda hata var, aralarda boşluk ta var. Bunlar da kalacak mı?
Aslında tam olarak ne olmasını istiyorsanız onun bir tam örneğini koysanız daha kolay anlaşılırdı.
6.11.2025 | 10:50:21 | ÇIKIŞ | 0:00:00 | ||
6.11.2025 | 11:31:28 | GİRİŞ | ############### |
27.11.2025 | 18:38:54 | ÇIKIŞ | 0:00:00 | ||
27.11.2025 | 18:41:35 | ÇIKIŞ | 0:00:00 |
SÜRE HESAPLA butonuna bastığınzıda yeni bir sayfada hesaplamalarınız yapılır.Tabloda da açıkladım, kişi ve tarih bazında giriş çıkışlar arasındaki farkları hesaplayıp, gün içinde iş yerinde geçirilen süre hesaplanılıyor.
Söylediğiniz işlem bu.
Şöyle bunlar giriş çıkış kart bilgileri. Bu örnekte en sonda tek giriş var, çıkışı yok, bunu hatalı bilgi kabul edeceğiz, sondaki tek giriş dikkate alınmayacak.
6.11.2025
10:50:21ÇIKIŞ
0:00:006.11.2025
11:31:28GİRİŞ
###############
27.11'de 72, 73.ncü satırda da 2 çıkış var arka arkaya ikinci çıkış bilgisinin de hatalı olduğunu kabul edeceğiz ve dikkate almayacağız.
27.11.2025
18:38:54ÇIKIŞ
0:00:0027.11.2025
18:41:35ÇIKIŞ
0:00:00
Sub Hesapla_Gecirilen_Sure()
' =========================================================================
' === BÖLÜM 1: DEĞİŞKEN TANIMLAMALARI VE HAZIRLIK
' =========================================================================
Dim wsRapor As Worksheet
Dim veriDizisi As Variant, sonucDizisi As Variant
Dim isimCol As Long, tarihCol As Long, saatCol As Long, durumCol As Long
Dim sonGirisSaati As Variant, sonGirisSatirIndex As Long
Dim sonSatir As Long, i As Long
Application.ScreenUpdating = False
On Error Resume Next
Set wsRapor = ThisWorkbook.Worksheets("Rapor")
If wsRapor Is Nothing Then
MsgBox "'Rapor' adında bir sayfa bulunamadı. Lütfen önce verileri düzenleyin.", vbCritical
Exit Sub
End If
On Error GoTo 0
' =========================================================================
' === BÖLÜM 2: SIRALAMA (DOĞRU EŞLEŞTİRME İÇİN KRİTİK ADIM)
' =========================================================================
sonSatir = wsRapor.Cells(wsRapor.Rows.Count, "A").End(xlUp).Row
If sonSatir < 2 Then Exit Sub
With wsRapor.Sort
.SortFields.Clear
.SortFields.Add Key:=wsRapor.Range("A1:A" & sonSatir), SortOn:=xlSortOnValues, Order:=xlAscending
.SortFields.Add Key:=wsRapor.Range("F1:F" & sonSatir), SortOn:=xlSortOnValues, Order:=xlAscending
.SortFields.Add Key:=wsRapor.Range("G1:G" & sonSatir), SortOn:=xlSortOnValues, Order:=xlAscending
.SetRange wsRapor.Range("A1:I" & sonSatir)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
' =========================================================================
' === BÖLÜM 3: VERİLERİ İŞLEME (HAFIZADA)
' =========================================================================
' --- Sütunları ve Verileri Hazırla ---
' =========================================================================
' === DÜZELTME: SÜTUN İNDEKS DEĞİŞKENLERİNE DEĞER ATAMA ===
' =========================================================================
isimCol = 1 ' A sütunu
tarihCol = 6 ' F sütunu
saatCol = 7 ' G sütunu
durumCol = 9 ' I sütunu
' =========================================================================
' Sıralanmış verinin tamamını diziye al (A'dan I'ya kadar olan sütunlar)
veriDizisi = wsRapor.Range("A2:I" & sonSatir).Value
' Sonuçları tutacak diziyi oluştur (K sütunu için)
ReDim sonucDizisi(1 To UBound(veriDizisi, 1), 1 To 1)
sonGirisSaati = Empty
sonGirisSatirIndex = 0
' --- Ana Hesaplama Döngüsü ---
For i = 1 To UBound(veriDizisi, 1)
' Kişi veya gün değiştiyse hafızayı sıfırla
If i > 1 Then
If veriDizisi(i, isimCol) <> veriDizisi(i - 1, isimCol) Or _
veriDizisi(i, tarihCol) <> veriDizisi(i - 1, tarihCol) Then
sonGirisSaati = Empty
sonGirisSatirIndex = 0
End If
End If
' --- Eşleştirme Mantığı ---
If veriDizisi(i, durumCol) = "GİRİŞ" Then
If IsEmpty(sonGirisSaati) Then
sonGirisSaati = veriDizisi(i, saatCol) ' Saati hafızaya al
sonGirisSatirIndex = i
End If
ElseIf veriDizisi(i, durumCol) = "ÇIKIŞ" Then
If Not IsEmpty(sonGirisSaati) Then
Dim gecenSure As Variant
gecenSure = CDate(veriDizisi(i, saatCol)) - CDate(sonGirisSaati)
sonucDizisi(sonGirisSatirIndex, 1) = gecenSure
sonGirisSaati = Empty
sonGirisSatirIndex = 0
End If
End If
Next i
' =========================================================================
' === BÖLÜM 4: SONUÇLARI YAZMA VE BİÇİMLENDİRME
' =========================================================================
wsRapor.Range("K1").Value = "Süre"
wsRapor.Range("K2").Resize(UBound(sonucDizisi, 1), 1).Value = sonucDizisi
On Error Resume Next
Dim bosHuceler As Range
Set bosHuceler = wsRapor.Range("K2:K" & sonSatir).SpecialCells(xlCellTypeBlanks)
If Not bosHuceler Is Nothing Then
bosHuceler.Value = 0
End If
On Error GoTo 0
wsRapor.Columns("K").NumberFormat = "[h]:mm:ss"
wsRapor.Columns("K").AutoFit
Application.ScreenUpdating = True
MsgBox "Her bir kişi için içeride geçirilen süreler hesaplanarak 'Rapor' sayfasındaki K sütununa yazılmıştır.", vbInformation, "İşlem Tamamlandı"
End Sub