Yardım puantaj hazırlama

selcuk23 · 27 Kasım 2017

Merhabalar;
Ekteki dosyada aylık vardiya ve gündüz personelinin nöbet tarihlerine göre bir puantaj tablosu hazırlamam gerekiyor. Manuel olarak puantaj hazırlamak bir hayli zaman ve sıkıntılı oluyor. Dosya içerisinde gerekli açıklamalar ve örnek olarak her vardiyadan bir kişinin puantajını doldurdum.. Dosyadaki açıklamalara göre bu konuda bir çalışma hazırlayabilirmisiniz.

http://www.dosya.tc/server10/td14cj/ORNEK_PUANTAJ.rar.html

cems · 28 Kasım 2017

Öncelikle foruma hoş geldiniz

Bu bölümde konuya direk odaklı ve daha önce gelişik şekilde hazırlanmış ve bitirilmiş olan çalışmalar da var, inceleme fırsatınız oldu mu ?

http://www.excel.web.tr/f136/

selcuk23 · 28 Kasım 2017

Merhabalar;
Bir çoğunu inceledim. Çalışmalar çeşitli hesaplama türlerine sahip ama direk vardiya-puantaj odaklı değiller. eğer dosya içerisindeki açıklamaları okuduysanız amaç vardiyanın işe geliş tarihlerini girdiğimde puantaj kısmındaki personelinin puantajına otomotik işaretlemesi.

YUSUF44 · 28 Kasım 2017

Soruyu soran hemşeri olunca biraz daha özen istiyor doğal olarak.

Ekteki dosyada dosyanızı biraz geliştirdim. İnceleyiniz:

https://drive.google.com/file/d/1dj_767msT8OXKBvQXai9cWL5UFHOvo_o/view?usp=sharing

selcuk23 · 28 Kasım 2017

Yusuf Bey;
Tek kelimeyle harika olmuş; Açıkçası bu kadar kısa sürede böyle bir çalışma beklemiyordum. Elinize emeğinize sağlık hemşerim. Bunca zamandır hep boşuna zaman kaybı yaşamışız.

selcuk23 · 28 Kasım 2017

Yusuf Bey;
Öncelikle alışma bu haliyle zaten başarılı. Puantaja birde izin rapor vb. personelin işte olmadığı zaman dilimlerinide işlemem lazım.dosyaya ek yaptım. Bir bakar mısınız imkanı var mı

selcuk23 · 28 Kasım 2017

Yusuf bey;
Öncelikle çalışma bu haliyle yeterince başarılı. Puantaja birde izin rapor gibi personelin işe gelmediği günleri işlemem lazım. Dosyaya ek yaptım. Bakabilirmisiniz

http://www.dosya.tc/server10/jo90ht/ORNEK_PUANTAJ__2_.rar.html

YUSUF44 · 29 Kasım 2017

Günaydın.

Kodun son hali şöyledir:

Kod:

Sub puantaj()
Set s1 = Sheets("PUANTAJ")
Set s2 = Sheets("PERSONEL LİSTESİ")
Set s3 = Sheets("VARDİYA NÖBET CİZELGESİ")
Set s4 = Sheets("izin takip")

dönem = s1.[a1]
uyarı = MsgBox(s1.[B5] & " işlensin mi?" & Chr(10) & _
        "Vardiya çizelgesini ve personel listesini hazırladınız mı?", vbYesNo)
If uyarı = vbYes Then
    sonkişi = WorksheetFunction.Max(7, s1.Cells(Rows.Count, "A").End(3).Row)
    songün = WorksheetFunction.Max(2, s3.Cells(Rows.Count, "B").End(3).Row)
    sonpersonel = WorksheetFunction.Max(2, s2.Cells(Rows.Count, "A").End(3).Row)
    
    s1.Range("A7:AJ" & sonkişi).Clear
    
    s2.Range("A2:D" & sonpersonel).Copy: s1.[A7].PasteSpecial Paste:=xlPasteValues
    son = s1.Cells(Rows.Count, "A").End(3).Row

    For kişi = 7 To son
        For gün = 5 To 35
            If s1.Cells(2, gün) <> "" Then
                If s1.Cells(kişi, "D") = "SABİT" Then
                    If WorksheetFunction.Weekday(s1.Cells(6, gün), 2) <= 5 Then
                        s1.Cells(kişi, gün) = "X"
                    End If
                ElseIf s1.Cells(kişi, "D") = s1.Cells(1, gün) Or s1.Cells(kişi, "D") = s1.Cells(2, gün) Then
                    s1.Cells(kişi, gün) = "X"
                End If
            End If
        Next
        s1.Cells(kişi, "AJ").FormulaR1C1 = "=COUNTIF(RC[-31]:RC[-1],""X"")"
    Next
End If
Application.CutCopyMode = False

    With s1.Range("A7:AJ" & son).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With s1.Range("A7:AJ" & son).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With s1.Range("A7:AJ" & son).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Range("A7:D" & son).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("A7:D" & son).Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Range("A7:D" & son).Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Range("AJ7:AJ" & son).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("AJ7:AJ" & son).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("AJ7:AJ" & son).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Range("AJ7:AJ" & son).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With

    With Range("A7:AJ" & son).Font
        .Name = "Calibri"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("AJ7:AJ" & son).Font.Bold = True
    
    Range("E6:AJ" & son).FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=HAFTANINGÜNÜ(E$6;2)>5" ' satır toplamları
    Range("E6:AJ" & son).FormatConditions(Range("E6:AJ" & son).FormatConditions.Count).SetFirstPriority
    With Range("E6:AJ" & son).FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Range("E6:AJ" & son).FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249946592608417
    End With
    Range("E6:AJ" & son).FormatConditions(1).StopIfTrue = False

    With Range("E7:AJ" & son)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("A7:D" & son)
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Range("A7:A" & son)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    'İzin vs işleme
    sonizin = s4.Cells(Rows.Count, "A").End(3).Row
    For m = 7 To son
        If WorksheetFunction.CountIf(s4.Range("A1:A" & sonizin), s1.Cells(m, "B")) >= 1 Then
            For n = 2 To sonizin
                If s4.Cells(n, "A") = s1.Cells(m, "B") Then
                    For o = 5 To 35
                        If s1.Cells(6, o) <> "" Then
                            If s1.Cells(6, o) >= s4.Cells(n, "B") And s1.Cells(6, o) < s4.Cells(n, "C") Then
                                s1.Cells(m, o) = s4.Cells(n, "E")
                                s1.Cells(m, o).Interior.Color = vbRed
                            End If
                        End If
                    Next
                End If
            Next
        End If
    Next
        
MsgBox "İşlem tamamlandı"
End Sub

Yalnız izin işlemede bazı farklılıklar var. Şöyle ki:

1 - İzin takip sayfasında Mehmet Bektaş'ın izin başlama tarihi 16/11/2017, dönüş tarihi 22/12/2017 olduğu halde süresine 7 gün yazmışsınız ve örnek dosyada da 7 gün işlemişsiniz. Halbuki bu iki tarih arası 36 gündür. Verdiğim kod da buna göre son güne kadar izin işlemektedir. Muhtemelen bitiş tarihinin 22/11/2017 olması gerekiyordu.

2 - Yine Serkan Tur için 17/11/2017-27/11/2017 arası 10 günlük izin için örnek tabloda 24/11/2017'ye kadar işleme yapmışsınız. 25/11'e de puantaj işlemişsiniz.

3 - İzin takip sayfasında Nurettin Çevik için herhangi bir bilgi yok iken puantaj sayfasında 20/11-04/12 arasını işlemişsiniz.

4 - İzin takip sayfasında Mehmet Sali'nin 20/11-05/12 arası izinli olduğu görülüyor. Muhtemelen onun yerine Nurettin Çevik'e işleme yaptınız. Ancak benim kod Mehmet Sali'ye izin işlemedi. Çünkü puantaj ve personel listesi sayfasında Mehmet Sali'nin adının sonunda 1 karakter boşluk varken izin takip sayfasında o boşluk bırakılmamış.

Bu hatalar/farklılıklar dışında kod istenileni yerine getiriyor. Verdiğim haliyle kullanabilirsiniz.

Önerim ise izin takip sayfasını isim bazlı değil TC kimlik numarası bazlı hazırlamanızdır. Çünkü benzer isimler olabilir ama TC kimlik numarası benzersizdir.

Personel sayfasına TC kimlik numarasını hatalı girmemek için aşağıdaki kodları Personel sayfasının kod bölümüne yapıştırırsanız A sütununa veri girdiğinizde kontrol yapar, hatalıysa uyarır:

Kod:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
            
    If Selection.Count > 1 Then GoTo 10
    If Target <> "" Then
        If Len(Target) <> 11 Then
            MsgBox "TC Kimlik numarası 11 Rakamdan oluşmalıdır.", vbCritical, "Hatalı !"
            Exit Sub
        Else
            Dim mod1 As Integer, mod2 As Integer, TC1 As Integer, TC2 As Integer, TC3 As Integer, TC4 As Integer, TC5 As Integer, TC6 As Integer, TC7 As Integer, TC8 As Integer, TC9 As Integer, TC10 As Integer, TC11 As Integer
            TC1 = Mid(Target, 1, 1)
            TC2 = Mid(Target, 2, 1)
            TC3 = Mid(Target, 3, 1)
            TC4 = Mid(Target, 4, 1)
            TC5 = Mid(Target, 5, 1)
            TC6 = Mid(Target, 6, 1)
            TC7 = Mid(Target, 7, 1)
            TC8 = Mid(Target, 8, 1)
            TC9 = Mid(Target, 9, 1)
            TC10 = Mid(Target, 10, 1)
            TC11 = Mid(Target, 11, 1)
    
            mod1 = ((((TC1 + TC3 + TC5 + TC7 + TC9) * 7) - (TC2 + TC4 + TC6 + TC8)) Mod 10)
            mod2 = ((TC1 + TC2 + TC3 + TC4 + TC5 + TC6 + TC7 + TC8 + TC9 + TC10) Mod 10)
    
            If mod1 <> TC10 And mod2 <> TC11 Then
                MsgBox Target & " Geçersiz TC kimlik numarası", vbExclamation, "Dikkat !"
                Target.Select
                Target = ""
            End If
        End If
    End If
10:
End Sub

Aynı işlemi izin takip sayfası için uygulamak isterseniz koddaki A2:A ifadesini o sayfanın TC kimlik no sütununa göre değiştirmeniz gerekir örneğin B2:B gibi.

selcuk23 · 30 Kasım 2017

Evet izin tablosunu alel acele hazırlayıp ekledim hataları iyi tespit etmişsiniz.
Kodları bir türlü çalışmaya uygulayamadım yada çalışmadı hiç etki etmedi . ne isimli olanı nede tc halini. Size zahmet bu çalışmaya eklermisiniz.

http://www.dosya.tc/server10/jo90ht/...J__2_.rar.html

YUSUF44 · 30 Kasım 2017

O dosya silinmiş ama bendeki son halini aşağıdaki linkten indirebilirsiniz:

https://drive.google.com/file/d/1GgOq7GQGlAMzYlvLHnwrCsksGFocOMV0/view?usp=sharing

selcuk23 · 30 Kasım 2017

Yusuf bey çok teşekkürler gayet güzel oldu. Hakkınızı helal edin baya zamanınızı çaldık..

samtrat55 · 30 Kasım 2017

bende formüllerle hazırlanmış puantaj ve avans exceli var görüntüsü de gayet iyi puantaj da aylık otomatik toplam alacağı para aldığı avans ve avans sonrası kalan alacak olarak var kendim hazırladım yakın bir zamanda makrolu kullanıcı girişli bir puantaj hazırlamayı planlıyorum

selcuk23 · 3 Aralık 2017

İzinleri puantaja işlemede baya sıkıntı çıkartıyor. İsimleri kopyala yapıştir yapsamda, hücrede boşluk kontrolu yapsamda hatta yazı tipi vs. kontrolü yapmama rağmen izinleri puantaja işlemiyor.

YUSUF44 · 3 Aralık 2017

Örnek dosyada herhangi bir sıkıntı çıkarmadı. Nasıl bir sıkıntı olduğunu görmeden de yorum yapamam doğal olarak. Sıkıntılı halini, sıkıntının ne olduğunu da açıklayarak yüklerseniz incelemeye çalışırız.

selcuk23 · 28 Mart 2018

Mrh. Kullanmakta olduğum puantajda bazı sorunlar yaşıyorum. sorunları dosya içerisinde ki açıklamalar kısmına yazdım. yardımcı olur musunuz.
http://s7.dosya.tc/server4/upm6je/PUANTAJ.rar.html

selcuk23 · 28 Mart 2018

selcuk23' Alıntı:
Mrh. Kullanmakta olduğum puantajda bazı sorunlar yaşıyorum. sorunları dosya içerisinde ki açıklamalar kısmına yazdım. yardımcı olur musunuz. http://s7.dosya.tc/server4/upm6je/PUANTAJ.rar.html

Yardım edecek kimse yok mu ?

selcuk23 · 31 Mart 2018

Yardım lütfen.

Ömer BARAN · 1 Nisan 2018

Merhaba.

Öncelikle konu sayfalarında veya örnek belgelerde,
belli bir üyeyi muhatap alan soru sormanızın, sonuca ulaşmanızı zorlaştıracağını hatırlatmak isterim.

Görebildiğim sorunların çözümüne dönük önerilerim aşağıda.
-- FORMÜLLER menüsündeki AD TANIMLAMA kısmını açın ve valan (VARDİYA sayfasındaki alan anlamında)
adını verip aşağıdaki formülü kullanarak yeni bir AD TANIMLAMASI yapın.
Bu ad tanımlaması sayesinde, VARDİYA sayfasına yeni tarihler ve veriler yazdıkça PUANTAJ sayfasındaki formülleri güncellemeniz gerekmeyecek,
formüller yeni verileri de kapsayacaktır.
.

Kod:

=[COLOR="red"]DOLAYLI[/COLOR]("'VARDİYA NÖBET CİZELGESİ'!B3:F"&[COLOR="Red"]KAÇINCI[/COLOR](0+"31.12.9999";'VARDİYA NÖBET CİZELGESİ'!$B:$B;1))

-- PUANTAJ sayfası E1 hücresindeki formülü aşağıdakiyle değiştirin ve bu hücreyi sağa ve aşağı doğru AI4 hücresine kadar kopyalayın.
.

Kod:

=[COLOR="red"]EĞER[/COLOR](E$6="";"";[COLOR="red"]EĞER[/COLOR]([COLOR="Red"]EĞERSAY[/COLOR]([B][COLOR="Blue"][SIZE="4"]valan[/SIZE][/COLOR][/B];E$6)=0;"";[COLOR="Red"]DÜŞEYARA[/COLOR](E$6;[B][COLOR="Blue"][SIZE="4"]valan[/SIZE][/COLOR][/B];SATIR()+1;0)))

-- Sonra da PUANTAJ sayfasındaki PUANTAJ İŞLE isimli düğmeye tıklayın.

Sorularınızı sorarken "bazı sorunlar" deyimi garip kaçmış, sorularınızı sayfa/hücre vs adresi vererek ve
hangi durumda hangi sorunu yaşadığınızı net şekilde ifade etmenizde yarar görüyorum.

AÇIKLAMA adını verdiğiniz sayfada B14 hücresindeki formülü belgenin neresinde kullanıyorsunuz bunu göremedim.

İyi çalışmalar dilerim.
.

selcuk23 · 1 Nisan 2018

Ömer bey, eki kısmen güncelledim. Vermiş olduğunuz formüller hata verdi ve bir türlü uyarlayamadım. Örnek belge üzerinde düzenleyebilir misiniz ?

Grknpkdzn · 11 Temmuz 2019

YUSUF44' Alıntı:
O dosya silinmiş ama bendeki son halini aşağıdaki linkten indirebilirsiniz:

https://drive.google.com/file/d/1GgOq7GQGlAMzYlvLHnwrCsksGFocOMV0/view?usp=sharing

Yusuf bey merhaba.
Bende de 15 tane vardiyacı personel ve sabah, orta ve gece olmak üzere 3 vardiya,1 gün hafta tatili durumu var.
Buna göre yapmış olduğunuz dosyayı nasıl revize etmek gerekir?

Yardım puantaj hazırlama

selcuk23

cems

selcuk23

YUSUF44

Destek Ekibi

selcuk23

selcuk23

selcuk23

YUSUF44

Destek Ekibi

selcuk23

YUSUF44

Destek Ekibi

selcuk23

samtrat55

selcuk23

YUSUF44

Destek Ekibi

selcuk23

selcuk23

selcuk23

Ömer BARAN

Uzman

selcuk23

Grknpkdzn