Tazminat Puantaj Çalışması

Ömer · 23 Temmuz 2020

Dosyayla ilgili değil, bilgisayar işletim sistemiyle ilgili olabilir.
Sorunuzu anladım, toplamları alırken ben ayrım yapmadan toplatmıştım siz aya göre toplam gelsin istiyorsunuz. İnceleyip dönüş yaparım.

Ömer · 24 Temmuz 2020

Sayın @aligunes
Deneyiniz.

Kod:

Sub puantaj()

    Dim Si As Worksheet, St As Worksheet, son As Long, ilk_t As Date, son_t As Date, gun As Byte
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, k As Integer, j As Date, izn As String
    Dim d As Object, a1, a2, s, deg As String, sure As Double, ay As String, topla As Double
   
    Set Si = Sheets("İzin İcmal")
    Set St = Sheets("Liste")

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
   
    sure = Timer
   
    Sheets("Puantaj").Select
    Range("E4:AI203").ClearContents
   
    son = Cells(Rows.Count, "A").End(xlUp).Row - 1
    ay = WorksheetFunction.Proper(UCase(Replace(Replace([AJ2], "ı", "I"), "i", "İ")))
    ilk_t = CDate("1." & ay & "." & [AJ1])
    son_t = DateSerial([AJ1], Month("1." & ay & "." & [AJ1]) + 1, 0)
    gun = Day(son_t)
   
    St.Range("A2:G" & Rows.Count).ClearContents
    Range("A4").Resize(son - 3, 4).Copy
    St.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    St.Range("F2").Resize(son - 3, 1) = "3.BÖLGE"

    For i = 4 To 203
   
        If Cells(i, "B") <> "" Then
            Set d = CreateObject("Scripting.Dictionary")
            Cells(i, "E").Resize(1, gun) = "X"
           
            For j = ilk_t To son_t
                If Application.Weekday(j, 2) = 7 Then
                    Cells(i, Day(j) + 4) = ""
                End If
            Next j
           
            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, "D")
                    bts = Si.Cells(c.Row, "E")
                     
                    If bts < ilk_t And bsl < ilk_t Then
                    Else
                    izn = ""
                    If WorksheetFunction.CountIf(Si.[L:L], Si.Cells(c.Row, "G")) > 0 Then
                        k = WorksheetFunction.Match(Si.Cells(c.Row, "G"), Si.[L:L], 0)
                        izn = Si.Cells(k, "M")
                    End If
                   
                    topla = 0
                    If Si.Cells(c.Row, "F") > 0 Then
                        For j = ilk_t To son_t
                            If j >= bsl And j <= bts Then
                                Cells(i, Day(j) + 4) = izn
                                topla = topla + 1
                            End If
                        Next j
                    End If
                     
                    deg = Si.Cells(c.Row, "G")
                    If Not d.exists(deg) Then
                        s = topla
                        d.Add deg, s
                    Else
                        s = d.Item(deg)
                        s = s + topla
                        d.Item(deg) = s
                    End If
                   
                    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 k = 0 To d.Count - 1
                St.Cells(i - 2, "G") = St.Cells(i - 2, "G") & ", " & "(" & a2(k) & ")" & a1(k)
            Next k
           
            If St.Cells(i - 2, "G") <> "" Then
                St.Cells(i - 2, "G") = Right(St.Cells(i - 2, "G"), Len(St.Cells(i - 2, "G")) - 2)
            End If
           
            Set d = Nothing
            'topla = 0
             
        End If
    Next i

    With Application
        .Calculation = xlAutomatic
        Range("AJ4").Resize(son - 3, 1).Copy
        St.Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        .CutCopyMode = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
    MsgBox "İşlem Süresi --- " & Format(Timer - sure, "0.00")

End Sub

Ömer · 24 Temmuz 2020

aspava' Alıntı:
Ömer Hocam , Kontrol ettim diğerinde kullandığı izin süresinde "X" koyuyordu şimdi tarih aralığında koyuyor daha sağlıklı oldu. Sizi uğraştırmayacak ise eğer izin tarihi aralığında Pazar gününe Yada Resmi Tatile gelen güne izinli yazmasak olur mu ?

Sayın @aspava

Dosya eklemişsiniz fakat, pazar yada resmi tatil olursa izinli yazmayalım, ne yazalım? cevabını alamadım.

aspava · 24 Temmuz 2020

Ömer hocam , pazar günlerine denk geliyor ise "HT " yani hafta tatili , resmi tatil gününe denk gelirse
" RT" yani resmi tatil olacak hocam.

Ömer · 24 Temmuz 2020

Hem resmi tatil hem pazar olursa ne yazılmalı?

aspava · 24 Temmuz 2020

Pazar yazalim hocam.

Ömer · 24 Temmuz 2020

Sayın @aspava
Deneyiniz.

Kod:

Sub puantaj_aspava()

    Dim Si As Worksheet, Sp As Worksheet, St As Worksheet, son As Long, ilk_t As Date, son_t As Date, gun As Byte, d As Range, sut As Integer
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, k As Integer, j As Date, izn As String, tatil As Integer
    
    Set Si = Sheets("İzin İcmal")
    Set Sp = Sheets("Pazar icmal")
    Set St = Sheets("Tatil Günleri")
 
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
    
    Sheets("puantaj").Select
    Range("G5:AK198").ClearContents
    
    son = Cells(Rows.Count, "B").End(xlUp).Row
    ilk_t = CDate("1." & [AD2] & "." & [AI2])
    son_t = DateSerial([AI2], Month("1." & [AD2] & "." & [AI2]) + 1, 0)
    gun = Day(son_t)
 
    For i = 5 To son
    
        If Cells(i, "B") <> "" Then
        
            Cells(i, "G").Resize(1, gun) = "X"
            
            Set d = Sp.[A:A].Find(Cells(i, "B"), , xlFormulas, xlWhole)
            If Not d Is Nothing Then
                Adr = d.Address
                Do
                    If Sp.Cells(d.Row, "C") >= ilk_t And Sp.Cells(d.Row, "C") <= son_t 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 <> Adr
            End If
            
            If Cells(i, "F") >= ilk_t And Cells(i, "F") <= son_t And Cells(i, "F") <> "" And Day(Cells(i, "F")) <> 1 Then
                Cells(i, "G").Resize(1, Day(Cells(i, "F")) - 1) = ""
            End If
      
            If Cells(i, "AL") >= ilk_t And Cells(i, "AL") <= son_t And Cells(i, "AL") <> "" Then
                sut = son_t - Cells(i, "AL")
                If sut <> 0 Then
                    Cells(i, 7 + Day(Cells(i, "AL"))).Resize(1, sut) = ""
                End If
            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 bts < ilk_t And bsl < ilk_t Then
                    Else
                    izn = ""
                    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)
                        izn = Si.Cells(k, "L")
                    End If
                  
                    If Si.Cells(c.Row, "E") > 0 Then
                        For j = ilk_t To son_t
                            If j >= bsl And j <= bts Then
                                Cells(i, Day(j) + 6) = izn
                            End If
                        Next j
                    End If
                    End If
                    
                   Set c = Si.[A:A].FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
            
            For k = 7 To 37
                If Cells(i, k) <> "" Then
                    tatil = WorksheetFunction.CountIf(St.[D:D], ilk_t + k - 7)
                    If tatil > 0 Then
                        Cells(i, k) = "RT"
                    End If
                    If Cells(3, k) = "Pazar" Then
                        Cells(i, k) = "HT"
                    End If
                End If
            Next k
              
        End If
    Next i
      
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
End Sub

aspava · 24 Temmuz 2020

Ömer Hocam Günaydın , Bu sefer de farklı bir problemi beraberinde getirdi . Örnek olarak 06.07.2020 de işe giriş yapan personelin , öncesin de pazar yada resmi var ise otomatik HT , Yada RT yazıyor çünkü o şekilde olmasını istemiştim .

O yüzden çok fazla sizi uğraştırmamak için diğer verileri ben kendim doldururum. Yardımlarınız için teşekkür ederim. Selamlar , Saygılar.

Ömer · 24 Temmuz 2020

Sorun değil, sonradan ilavelerin dezavantajları oluyor maalesef. Müsait olunca inceleyip dönüş yaparım.

Ömer · 24 Temmuz 2020

Sayın @aspava
#47 numaralı mesajı güncelledim. Tüm olasılıkları deneyiniz(eski yada yeni), hata olursa tekrar bakarım.

aspava · 24 Temmuz 2020

Ömer Hocam ; Kontrolleri sağladım. Gözlemlediğim kadarı ile 2 sorun var.
1-çıkış tarihi , ayın son günü ( 31.07.2020) gibi 31 ' denk gelirse , şu şekilde bir hata veriyor. ( Cells(i, 7 + Day(Cells(i, "AL"))).Resize(1, son_t - Cells(i, "AL")) = "")

2- Puantajda , Pazar icmal dosyasından çalışan personelin çalıştığı güne "X" koymuyor.

Ömer · 24 Temmuz 2020

1. Soru tmm fakat, 2. Soruyla ilgili; sonradan eklemeler yaptığınız için sıralamayı İkimizde göz ardı ettik.
Hem Rt hem pazar çalışırsa ne yazılması gerekiyor? Puantajı etkileyecek bir çarpan olduğunu düşünüyorum.

aspava · 24 Temmuz 2020

Ömer Hocam ,gerçekten sizi çok yordum hakkınızı helal edin. Pazar İcmal sayfasına örnekte belirttiğim gibi bir dosya ekledim. Tarihin yanında pazar çalışması yazarsa ilgili tarihe puantaja "x" koysun , Resmi tatil çalışması yazar ise ilgili tarihe "RTÇ" yazsın. Hem resmi tatil hem Pazar günü aynı güne denk gelirse x yazsın yeterli olacaktır.

ckarabacak · 24 Temmuz 2020

Sn. Aspava ve aligunes merhaba

Ekte göndermiş olduğum puantaj formüllü olup, sizin isteklerinize ne kadar yardımcı olur bir inceleyelim dosyanın çalışma mantığı ile ilgili sorabilirsiniz. daha sonra istedikleriniz doğrultusunda sorularınız olursa siteden yardım talep edebilirsiniz.
İyi Çalışmalar.

aligunes · 28 Temmuz 2020

Ömer' Alıntı:

Sayın @aligunes
Deneyiniz.

Kod:

Sub puantaj()

    Dim Si As Worksheet, St As Worksheet, son As Long, ilk_t As Date, son_t As Date, gun As Byte
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, k As Integer, j As Date, izn As String
    Dim d As Object, a1, a2, s, deg As String, sure As Double, ay As String, topla As Double
  
    Set Si = Sheets("İzin İcmal")
    Set St = Sheets("Liste")

    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
  
    sure = Timer
  
    Sheets("Puantaj").Select
    Range("E4:AI203").ClearContents
  
    son = Cells(Rows.Count, "A").End(xlUp).Row - 1
    ay = WorksheetFunction.Proper(UCase(Replace(Replace([AJ2], "ı", "I"), "i", "İ")))
    ilk_t = CDate("1." & ay & "." & [AJ1])
    son_t = DateSerial([AJ1], Month("1." & ay & "." & [AJ1]) + 1, 0)
    gun = Day(son_t)
  
    St.Range("A2:G" & Rows.Count).ClearContents
    Range("A4").Resize(son - 3, 4).Copy
    St.Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    St.Range("F2").Resize(son - 3, 1) = "3.BÖLGE"

    For i = 4 To 203
  
        If Cells(i, "B") <> "" Then
            Set d = CreateObject("Scripting.Dictionary")
            Cells(i, "E").Resize(1, gun) = "X"
          
            For j = ilk_t To son_t
                If Application.Weekday(j, 2) = 7 Then
                    Cells(i, Day(j) + 4) = ""
                End If
            Next j
          
            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, "D")
                    bts = Si.Cells(c.Row, "E")
                    
                    If bts < ilk_t And bsl < ilk_t Then
                    Else
                    izn = ""
                    If WorksheetFunction.CountIf(Si.[L:L], Si.Cells(c.Row, "G")) > 0 Then
                        k = WorksheetFunction.Match(Si.Cells(c.Row, "G"), Si.[L:L], 0)
                        izn = Si.Cells(k, "M")
                    End If
                  
                    topla = 0
                    If Si.Cells(c.Row, "F") > 0 Then
                        For j = ilk_t To son_t
                            If j >= bsl And j <= bts Then
                                Cells(i, Day(j) + 4) = izn
                                topla = topla + 1
                            End If
                        Next j
                    End If
                    
                    deg = Si.Cells(c.Row, "G")
                    If Not d.exists(deg) Then
                        s = topla
                        d.Add deg, s
                    Else
                        s = d.Item(deg)
                        s = s + topla
                        d.Item(deg) = s
                    End If
                  
                    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 k = 0 To d.Count - 1
                St.Cells(i - 2, "G") = St.Cells(i - 2, "G") & ", " & "(" & a2(k) & ")" & a1(k)
            Next k
          
            If St.Cells(i - 2, "G") <> "" Then
                St.Cells(i - 2, "G") = Right(St.Cells(i - 2, "G"), Len(St.Cells(i - 2, "G")) - 2)
            End If
          
            Set d = Nothing
            'topla = 0
            
        End If
    Next i

    With Application
        .Calculation = xlAutomatic
        Range("AJ4").Resize(son - 3, 1).Copy
        St.Range("E2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        .CutCopyMode = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With
  
    MsgBox "İşlem Süresi --- " & Format(Timer - sure, "0.00")

End Sub

Yukarıdaki linkte yazılan makroda liste sekmesinde listeleme 2.satırdan başlıyordu üste bir satır eklemem gerekiyor listeleme 3.satırdan başlaması lazım kodlarda değişiklik için yardımcı olur musunuz. Yada değiştirmem gereken yeri belirtirseniz

Ömer · 28 Temmuz 2020

aligunes' Alıntı:
Yukarıdaki linkte yazılan makroda liste sekmesinde listeleme 2.satırdan başlıyordu üste bir satır eklemem gerekiyor listeleme 3.satırdan başlaması lazım kodlarda değişiklik için yardımcı olur musunuz. Yada değiştirmem gereken yeri belirtirseniz

Sayın @aligunes
Deneyiniz.

Kod:

Sub puantaj()

    Dim Si As Worksheet, St As Worksheet, son As Long, ilk_t As Date, son_t As Date, gun As Byte
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, k As Integer, j As Date, izn As String
    Dim d As Object, a1, a2, s, deg As String, sure As Double, ay As String, topla As Double

    Set Si = Sheets("İzin İcmal")
    Set St = Sheets("Liste")

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

    sure = Timer

    Sheets("Puantaj").Select
    Range("E4:AI203").ClearContents

    son = Cells(Rows.Count, "A").End(xlUp).Row - 1
    ay = WorksheetFunction.Proper(UCase(Replace(Replace([AJ2], "ı", "I"), "i", "İ")))
    ilk_t = CDate("1." & ay & "." & [AJ1])
    son_t = DateSerial([AJ1], Month("1." & ay & "." & [AJ1]) + 1, 0)
    gun = Day(son_t)

    St.Range("A3:G" & Rows.Count).ClearContents
    Range("A4").Resize(son - 3, 4).Copy
    St.Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Application.CutCopyMode = False
    St.Range("F3").Resize(son - 3, 1) = "3.BÖLGE"

    For i = 4 To 203

        If Cells(i, "B") <> "" Then
            Set d = CreateObject("Scripting.Dictionary")
            Cells(i, "E").Resize(1, gun) = "X"
         
            For j = ilk_t To son_t
                If Application.Weekday(j, 2) = 7 Then
                    Cells(i, Day(j) + 4) = ""
                End If
            Next j
         
            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, "D")
                    bts = Si.Cells(c.Row, "E")
                   
                    If bts < ilk_t And bsl < ilk_t Then
                    Else
                    izn = ""
                    If WorksheetFunction.CountIf(Si.[L:L], Si.Cells(c.Row, "G")) > 0 Then
                        k = WorksheetFunction.Match(Si.Cells(c.Row, "G"), Si.[L:L], 0)
                        izn = Si.Cells(k, "M")
                    End If
                 
                    topla = 0
                    If Si.Cells(c.Row, "F") > 0 Then
                        For j = ilk_t To son_t
                            If j >= bsl And j <= bts Then
                                Cells(i, Day(j) + 4) = izn
                                topla = topla + 1
                            End If
                        Next j
                    End If
                   
                    deg = Si.Cells(c.Row, "G")
                    If Not d.exists(deg) Then
                        s = topla
                        d.Add deg, s
                    Else
                        s = d.Item(deg)
                        s = s + topla
                        d.Item(deg) = s
                    End If
                 
                    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 k = 0 To d.Count - 1
                St.Cells(i - 1, "G") = St.Cells(i - 1, "G") & ", " & "(" & a2(k) & ")" & a1(k)
            Next k
         
            If St.Cells(i - 1, "G") <> "" Then
                St.Cells(i - 1, "G") = Right(St.Cells(i - 1, "G"), Len(St.Cells(i - 1, "G")) - 2)
            End If
         
            Set d = Nothing
            'topla = 0
           
        End If
    Next i

    With Application
        .Calculation = xlAutomatic
        Range("AJ4").Resize(son - 3, 1).Copy
        St.Range("E3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        .CutCopyMode = False
        .ScreenUpdating = True
        .EnableEvents = True
    End With

    MsgBox "İşlem Süresi --- " & Format(Timer - sure, "0.00")

End Sub

Ömer · 28 Temmuz 2020

aspava' Alıntı:
Ömer Hocam ,gerçekten sizi çok yordum hakkınızı helal edin. Pazar İcmal sayfasına örnekte belirttiğim gibi bir dosya ekledim. Tarihin yanında pazar çalışması yazarsa ilgili tarihe puantaja "x" koysun , Resmi tatil çalışması yazar ise ilgili tarihe "RTÇ" yazsın. Hem resmi tatil hem Pazar günü aynı güne denk gelirse x yazsın yeterli olacaktır.

Sayın @aspava
Yeni bir şart ve yeni bir sütun eklediğiniz için yapıyı tamamen değiştirmek zorunda kaldım.
Tüm şartları deneyip dönüş yapar mısınız. Detaylı deneme yapmadığım için hata olabilir.

Kod:

Sub puantaj_aspava()

    Dim Si As Worksheet, Sp As Worksheet, St As Worksheet, son As Long, ilk_t As Date, son_t As Date, gun As Byte, d As Range
    Dim i As Long, c As Range, Adr As String, bsl As Date, bts As Double, k As Integer, j As Date, izn As String, tatil As Integer, p As String
    
    Set Si = Sheets("İzin İcmal")
    Set Sp = Sheets("Pazar icmal")
    Set St = Sheets("Tatil Günleri")
 
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
        .EnableEvents = False
    End With
    
    Sheets("puantaj").Select
    Range("G5:AK198").ClearContents
    
    son = Cells(Rows.Count, "B").End(xlUp).Row
    ilk_t = CDate("1." & [AD2] & "." & [AI2])
    son_t = DateSerial([AI2], Month("1." & [AD2] & "." & [AI2]) + 1, 0)
    gun = Day(son_t)
 
    For i = 5 To son
    
        If Cells(i, "B") <> "" Then
            For j = ilk_t To son_t
                If j >= Cells(i, "F") And (j <= Cells(i, "AL") Or Cells(i, "AL") = "") Then
            
                    p = ""
                    Set d = Sp.[C:C].Find(j, , xlFormulas, xlWhole)
                    If Not d Is Nothing Then
                        Adr = d.Address
                        Do
                            If Sp.Cells(d.Row, "A") = Cells(i, "B") Then
                                If Sp.Cells(d.Row, "D") = "PAZAR ÇALIŞMASI" Then p = "X"
                                If p <> "X" And Sp.Cells(d.Row, "D") = "RESMİ TATİL ÇALIŞMASI" Then p = "RTÇ"
                            End If
                            Set d = Sp.[C:C].FindNext(d)
                        Loop While Not d Is Nothing And d.Address <> Adr
                    End If
                    
                    izn = ""
                    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 j >= bsl And j <= bts Then
                                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)
                                    izn = Si.Cells(k, "L")
                                Else
                                    izn = "Ş"
                                End If
                            End If
                            
                           Set c = Si.[A:A].FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                    
                    tatil = WorksheetFunction.CountIf(St.[D:D], j)
                    Cells(i, Day(j) + 6) = "X"
                    If Cells(3, Day(j) + 6) = "Pazar" And p = "" And tatil = 0 Then
                        Cells(i, Day(j) + 6) = "HT"
                    ElseIf p <> "" And izn = "" Then
                        Cells(i, Day(j) + 6) = p
                    ElseIf izn <> "" And tatil = 0 Then
                        Cells(i, Day(j) + 6) = izn
                    ElseIf tatil > 0 Then
                        Cells(i, Day(j) + 6) = "RT"
                    End If
                    
                End If
            Next j
        End If

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

aspava · 28 Temmuz 2020

Ömer Hocam , Merhaba Teşekkür ederim. Kontrol ettim sizin 47 Numaralı kod ile vermiş olduğunuz kodlar da sadece çıkış tarihi , ayın son günü ( 31.07.2020) olan kişiler de hata veriyordu ve pazar çalışmalarını eklemiyordu.

57. numaralı mesajdaki kodlar da hafta sonu resmi tatil ayrımı olmadan hepsine x koyuyor. sizi daha fazla yormamak adına ben onları manuel puantaja eklerim siz 47 numaralı mesajınız da ayın son günü denk gelirse ( Cells(i, 7 + Day(Cells(i, "AL"))).Resize(1, son_t - Cells(i, "AL")) = "") uyarısını düzeltirseniz benim için yeterli hocam.

Ömer · 28 Temmuz 2020

#47 numaralı mesajı güncelledim.
#57 numarada Öncelik sıralaması olarak HT yi hangi şartlarda koyacaktık?
(Sıralamayı tahmin ederek #57 numaralı mesajı güncelledim, tekrar deneyiniz.)

aspava · 28 Temmuz 2020

Ömer' Alıntı:
Son eklediğiniz sütun ve şart iptal mi oldu.

İptal olmadı hocam , sadece diğer etkenleri etkilediği ve sizi ugraştirmamak için manuel olarak veri girişi yaparım. 57 numaralı mesajda ki kodlarda tüm çalışanlara x koyuyor.hafta sonu ayrı mı yapamıyorum hocam.

Tazminat Puantaj Çalışması

Ömer

Moderatör

Ömer

Moderatör

Ömer

Moderatör

aspava

Ömer

Moderatör

aspava

Ömer

Moderatör

aspava

Ömer

Moderatör

Ömer

Moderatör

aspava

Ömer

Moderatör

aspava

Ekli dosyalar

ckarabacak

Ekli dosyalar

aligunes

Ömer

Moderatör

Ömer

Moderatör

aspava

Ömer

Moderatör

aspava