Puantaj Hk.

Korhan Ayhan · 6 Ekim 2020

Test edebilmem için EKİM ayına ait doğru şekilde girilmiş 5 satırlık bir örnek puantaj paylaşabilir misiniz?

1 kayıt için çıkış tarihi de giriniz. (EYLÜL çıkışlı olabilir.)

valentino06 · 6 Ekim 2020

Sayın Korhan Ayhan Hocam hesaplama kısmını boş bıraktım. Ne kadar teşekkür etsem az olur.

Korhan Ayhan · 6 Ekim 2020

Bu kodu deneyiniz.

Boş modüle uygulayın. Bir butona tanımlayıp kullanın.

Eğer hesaplamalarda bir sorun yoksa çalıştırıp performansını bildirirseniz sevinirim.

C++:

Option Explicit

Sub Puantaj_Hazirla()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet, Bos_Alan As Range, Son_Gun As Integer
    Dim Veri As Variant, Son As Long, Tarih As Variant, X As Long, Y As Byte, Say As Long, Mesai As Double
    
    Zaman = Timer
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    Set S1 = Sheets("PUANTAJ")
    
    Son = S1.Cells(S1.Rows.Count, "C").End(3).Row
    If Son = 8 Then Son = 9
    
    For Son_Gun = 37 To 34 Step -1
        If S1.Cells(7, Son_Gun) <> "" Then Exit For
    Next
    
    If Son > 7 Then
        On Error Resume Next
        Set Bos_Alan = Nothing
        Set Bos_Alan = S1.Range("G8:" & S1.Cells(Son, Son_Gun).Address(0, 0)).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        
        If Not Bos_Alan Is Nothing Then Bos_Alan = "X"
    End If
    
    On Error Resume Next
    Set S2 = Nothing
    Set S2 = Sheets(CStr(S1.Range("AD5")))
    On Error GoTo 0
    If S2 Is Nothing Then
        Application.DisplayAlerts = False
        S1.Copy After:=Sheets(Sheets.Count)
        Set S2 = ActiveSheet
        S2.Name = CStr(S1.Range("AD5"))
    End If
    
    Veri = S2.Range("B8:AL" & Son).Value
    Tarih = S2.Range("G7:" & S2.Cells(7, Son_Gun).Address(0, 0)).Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To 51)
    ReDim Gunluk_Saatler(1 To 31)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        If Veri(X, 2) <> "" Then
            If Veri(X, 37) = "" Or Veri(X, 37) >= Tarih(1, 1) Then
                Say = Say + 1
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = Veri(X, 2)
                Liste(Say, 3) = Veri(X, 3)
                Liste(Say, 4) = Veri(X, 4)
                Liste(Say, 5) = Veri(X, 5)
                Liste(Say, 37) = Veri(X, 37)
                
                For Y = LBound(Tarih, 2) To UBound(Tarih, 2)
                    If Veri(X, 5) <> "" Then
                        If Veri(X, 5) > Tarih(1, Y) Then
                            Veri(X, Y + 5) = ""
                        End If
                    End If
                    
                    If Veri(X, 37) <> "" Then
                        If Veri(X, 37) <= Tarih(1, Y) Then
                            Veri(X, Y + 5) = ""
                        End If
                    End If
                    
                    Liste(Say, Y + 5) = Veri(X, Y + 5)
                    If InStr(1, Veri(X, Y + 5), "X") > 0 Then
                        If Len(Veri(X, Y + 5)) = 1 Then
                            Liste(Say, 38) = Liste(Say, 38) + 7
                            Gunluk_Saatler(Y) = Gunluk_Saatler(Y) + 7
                        Else
                            If InStr(1, Veri(X, Y + 5), "+") > 0 Then
                                Mesai = Replace(Veri(X, Y + 5), "X", "")
                                Liste(Say, 38) = Liste(Say, 38) + 7
                                Liste(Say, 39) = Liste(Say, 39) + Mesai
                                Gunluk_Saatler(Y) = Gunluk_Saatler(Y) + 7 + Mesai
                            ElseIf InStr(1, Veri(X, Y + 5), "-") > 0 Then
                                Mesai = Replace(Veri(X, Y + 5), "X", "")
                                Liste(Say, 38) = Liste(Say, 38) + (7 + Mesai)
                                Liste(Say, 43) = Liste(Say, 43) + Mesai
                                Gunluk_Saatler(Y) = Gunluk_Saatler(Y) + (7 + Mesai)
                            End If
                        End If
                    End If
                
                    If InStr(1, Veri(X, Y + 5), "H") > 0 Then
                        If Len(Veri(X, Y + 5)) > 2 Then
                            If InStr(1, Veri(X, Y + 5), "+") > 0 Then
                                Mesai = Replace(Veri(X, Y + 5), "H", "")
                                Liste(Say, 40) = Liste(Say, 40) + Mesai
                                Gunluk_Saatler(Y) = Gunluk_Saatler(Y) + Mesai
                            End If
                        End If
                    End If
                    
                    If InStr(1, Veri(X, Y + 5), "B") > 0 Then
                        If Len(Veri(X, Y + 5)) > 1 Then
                            Mesai = Replace(Veri(X, Y + 5), "B", "")
                            Liste(Say, 41) = Liste(Say, 41) + Mesai
                            Gunluk_Saatler(Y) = Gunluk_Saatler(Y) + Mesai
                        End If
                    End If
                    
                    Liste(Say, 42) = Liste(Say, 38) + Liste(Say, 39) + Liste(Say, 40) + Liste(Say, 41)
                    
                    If InStr(1, Veri(X, Y + 5), "R") > 0 Then
                        If Len(Veri(X, Y + 5)) = 1 Then
                            Liste(Say, 44) = Liste(Say, 44) + 7
                        End If
                    End If
                
                    If InStr(1, Veri(X, Y + 5), "S") > 0 Then
                        If Len(Veri(X, Y + 5)) = 1 Then
                            Liste(Say, 45) = Liste(Say, 45) + 7
                        End If
                    End If
                
                    If InStr(1, Veri(X, Y + 5), "ID") > 0 Then
                        If Len(Veri(X, Y + 5)) = 2 Then
                            Liste(Say, 46) = Liste(Say, 46) + 7
                        End If
                    End If
                
                    If InStr(1, Veri(X, Y + 5), "EI") > 0 Then
                        If Len(Veri(X, Y + 5)) = 2 Then
                            Liste(Say, 47) = Liste(Say, 47) + 7
                        End If
                    End If
                
                    If InStr(1, Veri(X, Y + 5), "DI") > 0 Then
                        If Len(Veri(X, Y + 5)) = 2 Then
                            Liste(Say, 48) = Liste(Say, 48) + 7
                        End If
                    End If
                
                    If InStr(1, Veri(X, Y + 5), "ÖI") > 0 Then
                        If Len(Veri(X, Y + 5)) = 2 Then
                            Liste(Say, 49) = Liste(Say, 49) + 7
                        End If
                    End If
                
                    Liste(Say, 50) = Liste(Say, 44) + Liste(Say, 45) + Liste(Say, 46) + Liste(Say, 47) + Liste(Say, 48) + Liste(Say, 49)
                    Liste(Say, 51) = Liste(Say, 42) + Liste(Say, 50)
                Next
            End If
        End If
    Next

    S2.Range("B8:AZ" & S1.Rows.Count).ClearContents
    S2.Range("B8").Resize(Say, 51) = Liste
    S2.Range("B8").Resize(Say, 51).Sort S2.Range("C8"), xlAscending
    S2.Range("G4:AK4") = Gunluk_Saatler

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With

    MsgBox S1.Range("AI5") & " yili " & S1.Range("AD5") & " ayi puantaj cetveli olusturulmustur." & vbLf & vbLf & _
           "Islem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"

    Set Bos_Alan = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

valentino06 · 6 Ekim 2020

Sayın Korhan Ayhan Hocam ne kadar teşekkür etsem gerçekten az olur Hocam mükemmelsiniz. Hocam Hafta sonu mesaileri getirmiyor.lütfen bakabilirmisiniz.

Korhan Ayhan · 6 Ekim 2020

Üstteki kodu revize ettim. Tekrar deneyiniz.

valentino06 · 6 Ekim 2020

Sayın Korhan Ayhan Hocam çok teşekkür ederim. harika çalışıyor. Allah kat kat razı olsun. Hocam İsimleri A dan Z ye sıralamasını yaptırabilirmiyiz. Hocam günlük çalışma sürelerini G4 :AK4 Arasındaki verilerin gün bazında sadece ( "X,X+,X-,H+,B+" ) burdaki amaç günlük kaç saat çalışma olmuş hesaplamak için istiyorum. Hocam son olarak koda "AQ Toplam mesai sütunu ile "AY" Sütünü İzinler Toplamını bu ikisinin toplamlarını "AZ" Gerçekleşen saat toplam sütununa yazdırabilirmiyiz.

valentino06 · 6 Ekim 2020

Hocam " F " Sütununda "Bu Ay İşe Girmişse Tarih " lütfen örnek işe giriş tarihi 04.10.2020 hocam bu tarihten önce veri varsa silinmesini sağlayabilir miyiz. lütfen çok teşekkür ederim.

Korhan Ayhan · 6 Ekim 2020

EKİM sayfasına bakarsanız isimler zaten sıralanıyor.

Ek olarak başka ekleyeceğiniz şeyler var mı?

Çünkü kodu sürekli revize etme durumu oluşacak.

valentino06 · 7 Ekim 2020

Evet Hocam Özür dilerim sıralıyor. Hocam yukardaki 46 nolu mesajın haricinde "G ile AK arasındaki sütünları gizleyebilirmiyiz. gizle ve göster butonu yapılabilirmi lütfen.

Korhan Ayhan · 7 Ekim 2020

Gizleme ve gösterme için deneyiniz.

C++:

Sub Gizle_Goster()
    Range("G:AK").EntireColumn.Hidden = Not Range("G:AK").EntireColumn.Hidden
End Sub

valentino06 · 7 Ekim 2020

Çok teşekkürler Hocam

Korhan Ayhan · 7 Ekim 2020

#43 nolu mesajımda ki kodu güncelledim.

Tekrar deneyiniz.

valentino06 · 7 Ekim 2020

Sayın Korhan Ayhan Hocam Çok teşekkür ederim. Ellerinize sağlık kod çok güzel çalışıyor. Allah razı olsun. hocam 4 nolu mesajımda bir kod vermiştim. hocam bu kodu daha hızlı olarak puantaja uygulama imkanımız var mı hocam eğer sizin düzenlemiş olduğunuz kod yapısını değiştiriyorsa önemli değil tekrar çok teşekkür ederim. Allah'a emanet olun.

Saygılarımla,

İyi Günler Dilerim.

Korhan Ayhan · 7 Ekim 2020

Benim önerdiğim kod istediğiniz sonucu vermiyor mu?

Önerdiğim kod zaten hücreler boşsa otomatik olarak X ile dolduruyor.

valentino06 · 7 Ekim 2020

Hocam vermiş olduğunuz kod çok güzel çalışıyor. Çok teşekkür ederim. Günlük olarak da işlem yapmak için istemiştim. İkinci bir alternatif olarak.

Korhan Ayhan · 7 Ekim 2020

#4 nolu mesajınızda ki ilk talebinizi zaten kodlama yapıyor. (AM:AZ sütun aralığı toplatılıyor)
Bugün olan sütun aktif ve biçimlendirme olsun demişsiniz. Bunu koşullu biçimlendirme ile yapabilirsiniz. Aktif olmasından kastınız nedir bilmiyorum.
Diğer kalan güncelerde kısaltmalar olacaksa transparan olması hesaplamaya dahil olmaması anlamına gelmez. Bu durumda çalışma saatlerini hesaplamak için 7. satırdaki tarihleri baz alarak hesaplama yapmak gerekir.

Aşağıdaki ifadenizde ne demek istediğinizi maalesef anlamadım.

Hocam x- olanlar ( X-50 - X-7) Kadar "X+,H+B+ Olanlara ( +0,50 den + 15 kadar olsun. hocam lütfen yardımcı olabilirmisiniz.

valentino06 · 7 Ekim 2020

Korhan Ayhan Hocam ben sadece şu kodu uyarlıyabilir miyiz demek istemiştim. ve biraz daha hızlandırabilirmiyiz. bu kod personel sayısı fazla olduğunda çok yavaş çalışıyor.

Sub GÜN_DOLDUR()
son = WorksheetFunction.Max(5, Cells(Rows.Count, 2).End(3).Row)
gün = Day(Date)
For kiþi = 5 To son
If Cells(kiþi, gün + 2) = "" Then Cells(kiþi, gün + 2) = "X"
Next
End Sub

Korhan Ayhan · 7 Ekim 2020

Deneyiniz.

C++:

Sub Gun_Doldur()
    Dim S1 As Worksheet, Son As Long, Son_Gun As Integer, Bos_Alan As Range
    
    Set S1 = Sheets("PUANTAJ")
    
    Son = S1.Cells(S1.Rows.Count, "C").End(3).Row
    If Son = 8 Then Son = 9
    
    For Son_Gun = 37 To 34 Step -1
        If S1.Cells(7, Son_Gun) <> "" Then Exit For
    Next
    
    If Son > 7 Then
        On Error Resume Next
        Set Bos_Alan = Nothing
        Set Bos_Alan = S1.Range("G8:" & S1.Cells(Son, Son_Gun).Address(0, 0)).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        
        If Not Bos_Alan Is Nothing Then Bos_Alan = "X"
    End If

    Set Bos_Alan = Nothing
    Set S1 = Nothing

    MsgBox "Boş olan günler X ile doldurulmuştur."
End Sub

valentino06 · 7 Ekim 2020

Korhan Ayhan Hocam denedim hepsini dolduruyor. Normalde sadece bu günü doldurması gerekiyor. 07.10.2020 ama tüm ayı dolduruyor.

Korhan Ayhan · 7 Ekim 2020

Deneyiniz.

C++:

Sub Bugunu_X_Ile_Doldur()
    Dim S1 As Worksheet, Son As Long, Bugun As Range, Bos_Alan As Range
   
    Set S1 = ActiveSheet
   
    Son = S1.Cells(S1.Rows.Count, "C").End(3).Row
    If Son = 8 Then Son = 9
   
    Set Bugun = S1.Range("G7:AK7").Find(Day(Date), , xlValues, xlWhole)
    If Not Bugun Is Nothing Then
        If Son > 7 Then
            On Error Resume Next
            Set Bos_Alan = Nothing
            Set Bos_Alan = S1.Cells(8, Bugun.Column).Resize(Son - 7).SpecialCells(xlCellTypeBlanks)
            On Error GoTo 0
           
            If Not Bos_Alan Is Nothing Then
                Bos_Alan.Select
                Bos_Alan = "X"
                MsgBox "Boş olan hücreler X ile doldurulmuştur."
            Else
                MsgBox "Boş hücre bulunamadı!", vbExclamation
            End If
        End If
    End If

    Set Bugun = Nothing
    Set Bos_Alan = Nothing
    Set S1 = Nothing
End Sub

Puantaj Hk.

Korhan Ayhan

Administrator

valentino06

Ekli dosyalar

Korhan Ayhan

Administrator

valentino06

Ekli dosyalar

Korhan Ayhan

Administrator

valentino06

Ekli dosyalar

valentino06

Korhan Ayhan

Administrator

valentino06

Korhan Ayhan

Administrator

valentino06

Korhan Ayhan

Administrator

valentino06

Korhan Ayhan

Administrator

valentino06

Korhan Ayhan

Administrator

valentino06

Korhan Ayhan

Administrator

valentino06

Korhan Ayhan

Administrator