Tazminat Puantaj Çalışması

aligunes · 18 Temmuz 2020

Ekte sunduğum tazminat puantaj hazırlama çalışmasında FORMÜL yada MAKRO kullanarak yapmak istiyorum çalışmaya katkı sunacak arkadaşlara ve değerli hocalara şimdiden teşekkür ederim.

Ömer · 18 Temmuz 2020

Merhaba,

Bu işi formül ile değil makro ile yapmanız daha doğru olacaktır. Tekrar eden isimler, şarta göre tek hücrede birleştirilecek veriler vs. makroya daha uygun.

aligunes · 18 Temmuz 2020

doğru makro ile olur ben de öyle düşünüyorum bu çalışmayı MAKRO ile yapmaya yardım edecek değerli hocalardan yardım bekliyorum

ckarabacak · 18 Temmuz 2020

Sn. aligunes Merhaba

Aylık Tazminat ifadenizden şunumu anlamalıyız. Kişi veya kişilerin Aylık çalışma puantajı olarak mı düşünmeliyiz yoksa farklı bir çalışmamı, Aylık Tazminat Terimini çalışma hayatında sizin ilk defa ifade etmenizden ne anlamalıyız ki ona göre mantık yürütelim ve size örnek dosya veya dosyalar gönderebilelim. Zira Tazminat ifadesi çalışma hayatında belli bir süre çalışılması sonucunda koşullara uygun olması halinde yapılan toplu ödemedir.

Ömer · 18 Temmuz 2020

Deneyiniz.

Kod:

Sub puantaj()

    Dim Si As Worksheet, St As Worksheet, son As Long, trh As Date, gun As Byte, deg As String
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, d As Object
 
    Set Si = Sheets("İzin İcmal")
    Set St = Sheets("Lİste")
 
    Application.ScreenUpdating = False
    Sheets("Puantaj").Select

    son = Cells(Rows.Count, "B").End(xlUp).Row
    Range("D4:AH" & son).ClearContents
 
    trh = DateSerial(Year("1." & [AI2]), Month("1." & [AI2]) + 1, 0)
    gun = Day(trh)
 
    For i = 4 To son
        Cells(i, "D").Resize(1, gun) = "x"
        Set c = Si.[A:A].Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                bsl = Si.Cells(c.Row, "C")
                bts = Si.Cells(c.Row, "E")
                If bts > 0 Then
                    If Si.Cells(c.Row, "D") > trh Then bts = trh - bsl - 1
                    If Format(bsl, "MMMM") = WorksheetFunction.Proper(UCase(Replace(Replace([AI2], _
                        "ı", "I"), "i", "İ"))) Then
                        Cells(i, Day(bsl) + 3).Resize(1, bts) = ""
                    End If
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
 
    St.Range("D2:D" & Rows.Count).ClearContents
    For i = 2 To St.Cells(Rows.Count, "A").End(xlUp).Row
        Set d = CreateObject("Scripting.Dictionary")
        Set c = Si.[A:A].Find(St.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                deg = Si.Cells(c.Row, "F")
                If Not d.exists(deg) Then
                    d.Add deg, Nothing
                    St.Cells(i, "D") = St.Cells(i, "D") & "," & deg
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        St.Cells(i, "D") = Right(St.Cells(i, "D"), Len(St.Cells(i, "D")) - 1)
        Set d = Nothing
    Next i
 
End Sub

aligunes · 18 Temmuz 2020

ckarabacak' Alıntı:
Sn. aligunes Merhaba

Aylık Tazminat ifadenizden şunumu anlamalıyız. Kişi veya kişilerin Aylık çalışma puantajı olarak mı düşünmeliyiz yoksa farklı bir çalışmamı, Aylık Tazminat Terimini çalışma hayatında sizin ilk defa ifade etmenizden ne anlamalıyız ki ona göre mantık yürütelim ve size örnek dosya veya dosyalar gönderebilelim. Zira Tazminat ifadesi çalışma hayatında belli bir süre çalışılması sonucunda koşullara uygun olması halinde yapılan toplu ödemedir.

Tazminat maaş haricinde yapılan bir ek ödemedir. Her ayın 1..30 arası personelin izin-rapor..vs düşülerek kalan gün sayısı kadar yapılır puantajda personelin izinli ve raporlu olduğu günler tazminat alamaz fiilen çalıştığı gün alır. Bu nedenle sayfa sekmesinde personelin izin rapor takiplerinin yapıldığı sayfadan verilerin baz alınarak aylık puantaj hazırlayarak hem izin icmal takibi hem de tazminat hazırlamak istiyorum.

Ömer · 18 Temmuz 2020

Kodları denediniz mi?

aligunes · 18 Temmuz 2020

Ömer' Alıntı:
Kodları denediniz mi?

kodları denedim çalışıyor elinize sağlık sadece liste sayfasında aşağıdaki şekilde yazması gerekiyor bir kişiye ait aynı izin türlerini toplayarak aşağıdaki şekilde yazması gerekiyor

(14) Gün İdari İzin (Tecrit)

(5) Gün Senelik izin, (1) Gün Evlilik Yıl Dönümü İzni

Ömer · 19 Temmuz 2020

Deneyiniz.

Kod:

Sub puantaj()

    Dim Si As Worksheet, St As Worksheet, son As Long, trh As Date, gun As Byte, deg As String, j As Integer
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, d As Object, a1, a2, s
 
    Set Si = Sheets("İzin İcmal")
    Set St = Sheets("Lİste")
 
    Application.ScreenUpdating = False
    Sheets("Puantaj").Select

    son = Cells(Rows.Count, "B").End(xlUp).Row
    Range("D4:AH" & son).ClearContents
 
    trh = DateSerial(Year("1." & [AI2]), Month("1." & [AI2]) + 1, 0)
    gun = Day(trh)
 
    For i = 4 To son
        Cells(i, "D").Resize(1, gun) = "x"
        Set c = Si.[A:A].Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                bsl = Si.Cells(c.Row, "C")
                bts = Si.Cells(c.Row, "E")
                If bts > 0 Then
                    If Si.Cells(c.Row, "D") > trh Then bts = trh - bsl - 1
                    If Format(bsl, "MMMM") = WorksheetFunction.Proper(UCase(Replace(Replace([AI2], _
                        "ı", "I"), "i", "İ"))) Then
                        Cells(i, Day(bsl) + 3).Resize(1, bts) = ""
                    End If
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
 
    St.Range("D2:D" & Rows.Count).ClearContents
    For i = 2 To St.Cells(Rows.Count, "A").End(xlUp).Row
        Set d = CreateObject("Scripting.Dictionary")
        Set c = Si.[A:A].Find(St.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                deg = Si.Cells(c.Row, "F")
                If Not d.exists(deg) Then
                    s = Si.Cells(c.Row, "E")
                    d.Add deg, s
                Else
                    s = d.Item(deg)
                    s = s + Si.Cells(c.Row, "E")
                    d.Item(deg) = s
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        a1 = d.keys: a2 = d.items
        For j = 0 To d.Count - 1
            St.Cells(i, "D") = St.Cells(i, "D") & ", " & "(" & a2(j) & ")" & a1(j)
        Next j
        St.Cells(i, "D") = Right(St.Cells(i, "D"), Len(St.Cells(i, "D")) - 2)
        Set d = Nothing
    Next i
    
End Sub

aspava · 19 Temmuz 2020

Ömer Hocam ; konudan alakasız olarak bir soru da ben sormak istiyorum. İzin İcmal sayfasında "senelik izin " giden bir personel 'i puantaj sayfasında boş değil de "Yİ" izin gibi yazdırabiliriz. Mazeret izni ise " Mİ" gibi .. sizin kodlarınızı kendi puantaj tabloma göre uyarlamak istiyorum.

Ömer · 19 Temmuz 2020

Merhaba,

Evet olabilir. Yalnız şartlar sadece iki şart değil sanırım. Fazlaysa; bunun için bence şartlar ve karşılıklarını hücreye yazıp oradan almak daha doğru olacaktır. Örneğin K:L sütun aralığına. Değilse tüm şartları söylerseniz ona göre hazırlayayım.

aspava · 19 Temmuz 2020

o zaman ben gece gece sizi yormayayım hocam, örnek bir dosya hazırlayayım müsait olduğunuz da ilgilenirseniz sevinirim.

Ömer · 19 Temmuz 2020

Eki inceleyiniz. "İzin İcmal" sayfası K sütununa izin adlarını L sütununa kodlarını kendimce yazdım. Siz kendinize göre uyarlarsınız.

Not: #16 numaralı mesaj doğrultusunda dosya güncellendi.

aligunes · 19 Temmuz 2020

Ömer' Alıntı:
Eki inceleyiniz. "İzin İcmal" sayfası K sütununa izin adlarını L sütununa kodlarını kendimce yazdım. Siz kendinize göre uyarlarsınız.

Ömer hocam izin icmalde bir kişi ör: 25/07/2020 de 14 gün izne ayrıldı dönüş tarihi 08/08/2020 o zaman makro hata veriyor

Burada Puantaj AI1 ve AI2 deki tarih baz alınarak sadece ilgili aya denk gelen günleri düşse sorun çözülecek AI2:AI2 ye AĞUSTOS 2020 girdiğimde de Ağustos ayına denk gelen günleri düşer tazminat ay baz alınarak hazırlanıyor personel ayın değişik tarihlerinde izinli raporlu olduğundan bir sonraki aya da sarkabiliyor önemli olan ay baz alınarak puantaj hazırlamak listeye de açıklama kısmına aya denk gelen düşüm yaptığı gün sayısını yazar

aligunes · 19 Temmuz 2020

Ömer hocam ya da MAKRO yazabilen diğer hocalarım 13 nolu mesajda belirtmiş olduğum hatayı düzeltebilir misiniz ?

Ömer · 20 Temmuz 2020

Deneyiniz.
"İzin İcmal" sayfası E sütununa =D2-C2+1 formülünü yazmanız daha doğru olacaktır.

Kod:

Sub puantaj()

    Dim Si As Worksheet, St As Worksheet, son As Long, trh As Date, gun As Byte, deg As String, j As Integer
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, d As Object, a1, a2, s, ay As String
 
    Set Si = Sheets("İzin İcmal")
    Set St = Sheets("Lİste")
 
    Application.ScreenUpdating = False
    Sheets("Puantaj").Select

    son = Cells(Rows.Count, "B").End(xlUp).Row
    Range("D4:AH" & son).ClearContents
 
    trh = DateSerial(Year("1." & [AI2]), Month("1." & [AI2]) + 1, 0)
    gun = Day(trh)
 
    For i = 4 To son
        Cells(i, "D").Resize(1, gun) = "x"
        Set c = Si.[A:A].Find(Cells(i, "B"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                bsl = Si.Cells(c.Row, "C")
                bts = Si.Cells(c.Row, "D")
                ay = WorksheetFunction.Proper(UCase(Replace(Replace([AI2], "ı", "I"), "i", "İ")))
                
                If Format(bsl, "MMMM") <> ay And Format(bts, "MMMM") <> ay Then Exit Do
                
                If Si.Cells(c.Row, "E") > 0 Then
                    
                    If Format(bsl, "MMMM") = ay And Format(bts, "MMMM") = ay Then
                        bsl = Day(bsl)
                        bts = Si.Cells(c.Row, "E")
                    ElseIf Format(bsl, "MMMM") <> ay And Format(bts, "MMMM") = ay Then
                        bsl = 1
                        bts = Day(bts)
                    Else
                        bts = trh - bsl + 1
                        bsl = Day(bsl)
                    End If
                                        
                    Cells(i, bsl + 3).Resize(1, bts) = ""
                    
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next i
 
    St.Range("D2:D" & Rows.Count).ClearContents
    For i = 2 To St.Cells(Rows.Count, "A").End(xlUp).Row
        Set d = CreateObject("Scripting.Dictionary")
        Set c = Si.[A:A].Find(St.Cells(i, "A"), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                deg = Si.Cells(c.Row, "F")
                If Not d.exists(deg) Then
                    s = Si.Cells(c.Row, "E")
                    d.Add deg, s
                Else
                    s = d.Item(deg)
                    s = s + Si.Cells(c.Row, "E")
                    d.Item(deg) = s
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
        a1 = d.keys: a2 = d.items
        For j = 0 To d.Count - 1
            St.Cells(i, "D") = St.Cells(i, "D") & ", " & "(" & a2(j) & ")" & a1(j)
        Next j
        St.Cells(i, "D") = Right(St.Cells(i, "D"), Len(St.Cells(i, "D")) - 2)
        Set d = Nothing
    Next i
    
End Sub

aspava · 20 Temmuz 2020

Ömer Hocam Merhaba ;
İyi Akşamlar ,

Arkadaşın puantajı kendime uyarlamaya çalıştım ama başarılı olamadım. Benim bir de ilave olarak yapmak istediğim Pazar günleri çalışan personelleri yazdığım " Pazar icmal" dosyası dışında kalan personellerin pazar günleri puantajına x değil de " HT" ibaresi koyması.

aligunes · 20 Temmuz 2020

Ömer hocam elinize sağlık puantaj makro çalışıyor yani seçtiğim ayın iznini düşüyor şimdi de puantajda boş olan yerlere izinlerin kodlamasını yazıyordu daha öce şimdi yazmıyor ayrıca listede açıklama kısmına toplam izni yazıyor mesela 25 temmuzda başlayan 4 Ağustosta biten izin için puantajı doğru işaretliyor liste açıklama kısmına ilgili aya ait olan toplamı değil genel toplamı yazıyor dediğim gibi bir de izin kodlamalarını yazmıyor birde puantajda isimle sicil arasına unvan ekleyeceğim kod bozulur mu? ayrıca puantajda izinli olunan yerleri hücreyi gri renk yapabilir miyiz.

Ömer · 21 Temmuz 2020

aligunes' Alıntı:
puantajda isimle sicil arasına unvan ekleyeceğim kod bozulur mu? ayrıca puantajda izinli olunan yerleri hücreyi gri renk yapabilir miyiz.

Sayın @aligunes
Son 2 yazdığınızdan başlayayım. Diğer yazdıklarınızı anlamadım.

1) Eğer eski sütunların yeri değişirse evet bozulur.,
2) Yapılabilir, yalnız diğer konular netleşince ilavesini yaparız.

Ömer · 21 Temmuz 2020

aspava' Alıntı:
Ömer Hocam Merhaba ;
İyi Akşamlar ,

Arkadaşın puantajı kendime uyarlamaya çalıştım ama başarılı olamadım. Benim bir de ilave olarak yapmak istediğim Pazar günleri çalışan personelleri yazdığım " Pazar icmal" dosyası dışında kalan personellerin pazar günleri puantajına x değil de " HT" ibaresi koyması.

Sayın @aspava
Deneyiniz.

Kod:

Sub puantaj_aspava()

    Dim Si As Worksheet, Sp As Worksheet, trh As Date, gun As Byte, deg As String, j As Byte, Adr1 As String
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, d As Range, k As Byte, ay As String

    Set Si = Sheets("İzin İcmal")
    Set Sp = Sheets("Pazar icmal")

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With

    Sheets("puantaj").Select
    Range("G5:AK104").ClearContents
   
    ay = WorksheetFunction.Proper(UCase(Replace(Replace([AD2], "ı", "I"), "i", "İ")))
    trh = DateSerial([AI2], Month("1." & [AD2] & "." & [AI2]) + 1, 0)
    gun = Day(trh)

    For i = 5 To 104
   
        Cells(i, "G").Resize(1, gun) = "X"
       
        For j = 7 To 37
            If Cells(3, j) = "Pazar" Then
                Cells(i, j) = "HT"
            End If
        Next j
       
        If Format(Cells(i, "F"), "MMMM") = ay And Cells(i, "F") <> "" Then
            Cells(i, "G").Resize(1, Day(Cells(i, "F"))) = ""
        End If
       
        If Format(Cells(i, "AL"), "MMMM") = ay And Cells(i, "AL") <> "" Then
            Cells(i, 7 + Day(Cells(i, "AL"))).Resize(1, trh - Cells(i, "AL")) = ""
        End If
       
        Set c = Si.[A:A].Find(Cells(i, "B"), , xlFormulas, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                bsl = Si.Cells(c.Row, "C")
                bts = Si.Cells(c.Row, "D")
               
                If Format(bsl, "MMMM") <> ay And Format(bts, "MMMM") <> ay Then Exit Do
               
                If Si.Cells(c.Row, "E") > 0 Then
                   
                    If Format(bsl, "MMMM") = ay And Format(bts, "MMMM") = ay Then
                        bsl = Day(bsl)
                        bts = Si.Cells(c.Row, "E")
                    ElseIf Format(bsl, "MMMM") <> ay And Format(bts, "MMMM") = ay Then
                        bsl = 1
                        bts = Day(bts)
                    Else
                        bts = trh - bsl + 1
                        bsl = Day(bsl)
                    End If
                       
                    If WorksheetFunction.CountIf(Si.[K:K], Si.Cells(c.Row, "F")) > 0 Then
                        k = WorksheetFunction.Match(Si.Cells(c.Row, "F"), Si.[K:K], 0)
                        Cells(i, bsl + 6).Resize(1, bts) = Si.Cells(k, "L")
                    Else
                        Cells(i, bsl + 6).Resize(1, bts) = ""
                    End If
                       
                End If
                Set c = Si.[A:A].FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
       
        Set d = Sp.[A:A].Find(Cells(i, "B"), , xlFormulas, xlWhole)
        If Not d Is Nothing Then
            Adr1 = d.Address
            Do
                If Format(Sp.Cells(d.Row, "C"), "MMMM") = ay Then
                    Cells(i, Day(Sp.Cells(d.Row, "C")) + 6) = "X"
                End If
                Set d = Sp.[A:A].FindNext(d)
            Loop While Not d Is Nothing And d.Address <> Adr1
        End If
       
    Next i

    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
End Sub

Tazminat Puantaj Çalışması

aligunes

Ekli dosyalar

Ömer

Moderatör

aligunes

ckarabacak

Ömer

Moderatör

aligunes

Ömer

Moderatör

aligunes

Ömer

Moderatör

aspava

Ömer

Moderatör

aspava

Ömer

Moderatör

Ekli dosyalar

aligunes

aligunes

Ömer

Moderatör

aspava

Ekli dosyalar

aligunes

Ömer

Moderatör

Ömer

Moderatör