GİRİŞ - ÇIKIŞ SAATLİ MESAİ VE MOLA HESAPLAMA

[ozanyakar]

Merhaba, Sayfa 1 de , 30 günde personelin giriş-çıkış saatine göre toplam çalıştığı saat bilgisi mevcut. Sayın ÖmerFaruk Hocamın değerli katkıları ile hazırlanmış bir çalışma.

Hemen yan sayfaya ; şu kriterlere göre personelin aylık ne kadar mola kullandığını nasıl hesaplarız ?

	KRİTERLER
A)	GÜNLÜK GİRİŞ-ÇIKIŞ SAATLERİNE BAK, ÇALIŞMA YOKSA MOLA YOK
B)	GÜNLÜK GİRİŞ VE ÇIKIŞ SÜRESİ ARASINDA 0<4 SAAT (4 SAAT DAHİL) İÇİN 15 DAKİKA MOLA VER
C)	GÜNLÜK GİRİŞ VE ÇIKIŞ SÜRESİ 4 < 7.5 SAAT (7.5 SAAT DAHİL) İÇİN YARIM SAAT MOLA VER
D)	GÜNLÜK GİRİŞ VE ÇIKIŞ SÜRESİ 7.5 < 11 SAAT ( 11 SAAT DAHİL) İÇİN 1 SAAT MOLA VER
E)	GÜNLÜK GİRİŞ VE ÇIKIŞ SÜRESİ 11 < 15 SAAT ( 15 SAAT DAHİL) İÇİN 1.5 SAAT MOLA VER
F)	GÜNLÜK GİRİŞ VE ÇIKIŞ SÜRESİ 15 < 18 SAAT ( 18 SAAT DAHİL) İÇİN 2 SAAT MOLA VER
G)	GÜNLÜK GİRİŞ VE ÇIKIŞ SÜRESİ 18 < 24 SAAT ( 24 SAAT DAHİL) İÇİN 3 SAAT MOLA VER
	AY SONUNDA TOPLAM MOLA SÜRESİNİ SAYI CİNSİNDEN HESAPLA

 

[ÖmerFaruk]

İlk verdiğim kodların yerine aşağıdakini kullanın, Mola tablosunu da oluştursun.
Size bir de kolaylık tavsiyem olsun.
Böyle tablolarda ben toplam satırını en üste, ya da en sola alıyorum ki satır sütun artışlarından etkilenmeyeyim.

Sub MesaiHesapla()
Application.ScreenUpdating = False
Sheets("Mola").Range("C4:AJ1000").ClearContents
For i = 4 To Range("A" & Rows.Count).End(3).Row
    Zaman = 0
    Mola = 0
    TopMola = 0
    For k = 3 To Cells(1, Columns.Count).End(1).Column + 1
        If Cells(3, k) = "G.S." And Cells(i, k) <> "" Then
            ilk = CDbl(Cells(1, k)) + CDbl(Cells(i, k))
        End If
        If Cells(3, k) = "Ç.S." And Cells(i, k) <> "" Then
            son = CDbl(Cells(1, k - 1)) + CDbl(Cells(i, k))
            If son < ilk Then son = son + 1
        End If
        If ilk > 0 And son > 0 Then
            Zaman = Zaman + son - ilk
            Select Case (son - ilk) * 24
                Case Is <= 4
                    Mola = 0.25
                Case Is <= 7.5
                    Mola = 0.5
                Case Is <= 11
                    Mola = 1
                Case Is <= 15
                    Mola = 1.5
                Case Is <= 18
                    Mola = 2
                Case Else
                    Mola = 3
            End Select
            Sheets("Mola").Cells(i, k / 2 + 1) = Mola
            Sheets("Mola").Cells(i, k / 2 + 1).NumberFormat = "00.00"
            TopMola = TopMola + Mola
            son = 0: ilk = 0
        End If
    Next k
    Sheets("Mola").Cells(i, Int(k / 2) + 4) = TopMola
    Sheets("Mola").Cells(i, Int(k / 2) + 4).NumberFormat = "00.00"
    Cells(i, k + 1) = Zaman * 24
    Cells(i, k + 1).NumberFormat = "00.00"
Next i
Application.ScreenUpdating = True
End Sub

 

[ozanyakar]

İlk verdiğim kodların yerine aşağıdakini kullanın, Mola tablosunu da oluştursun.
Size bir de kolaylık tavsiyem olsun.
Böyle tablolarda ben toplam satırını en üste, ya da en sola alıyorum ki satır sütun artışlarından etkilenmeyeyim.

Sub MesaiHesapla()
Application.ScreenUpdating = False
Sheets("Mola").Range("C4:AJ1000").ClearContents
For i = 4 To Range("A" & Rows.Count).End(3).Row
    Zaman = 0
    Mola = 0
    TopMola = 0
    For k = 3 To Cells(1, Columns.Count).End(1).Column + 1
        If Cells(3, k) = "G.S." And Cells(i, k) <> "" Then
            ilk = CDbl(Cells(1, k)) + CDbl(Cells(i, k))
        End If
        If Cells(3, k) = "Ç.S." And Cells(i, k) <> "" Then
            son = CDbl(Cells(1, k - 1)) + CDbl(Cells(i, k))
            If son < ilk Then son = son + 1
        End If
        If ilk > 0 And son > 0 Then
            Zaman = Zaman + son - ilk
            Select Case (son - ilk) * 24
                Case Is <= 4
                    Mola = 0.25
                Case Is <= 7.5
                    Mola = 0.5
                Case Is <= 11
                    Mola = 1
                Case Is <= 15
                    Mola = 1.5
                Case Is <= 18
                    Mola = 2
                Case Else
                    Mola = 3
            End Select
            Sheets("Mola").Cells(i, k / 2 + 1) = Mola
            Sheets("Mola").Cells(i, k / 2 + 1).NumberFormat = "00.00"
            TopMola = TopMola + Mola
            son = 0: ilk = 0
        End If
    Next k
    Sheets("Mola").Cells(i, Int(k / 2) + 4) = TopMola
    Sheets("Mola").Cells(i, Int(k / 2) + 4).NumberFormat = "00.00"
    Cells(i, k + 1) = Zaman * 24
    Cells(i, k + 1).NumberFormat = "00.00"
Next i
Application.ScreenUpdating = True
End Sub

Hocam ellerine sağlık. Tam istediğim gibi oldu. Sıfır hata. İşyerinde güya kart okutma sistemi var, inanın şu verilerin 10 da birini alamıyoruz. Çok teşekkür ederim, elinize , emeğinize sağlık. Ayrıca tavsiyelerinizi uyguluyor olacağım bu ve bundan sonraki çalışmalarda.