Personel Puantaj çizelgesi

[yrmzjojuk]

Merhabalar

Çok araştırmama rağmen bulamadıgım ve her ay düzenli el ile yaptıgımda 2-3 günümü alan bir iş yükü için yardımlarınız bekliyorum benim yapmak istediğim ama büyük uğraşlarım sonucunda yapamadığım konuyu size şöyle resimler anlaşılır olarak izah edeyim

resimdede anlattıgım gibi 30 gün aralıgına toplam saat bölünecek yani ben toplamı gireceğim örn. 41 saat gireceğim o belirlediğim hücreler arasına 2 ile 7 saat arası sayıyı rasgele atayacak harf girili olan hücrelere işlem yapmayacak örnek puantajı ek olarak koydum onun üzerinde işlem yapacağım şimdiden teşekkürler

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırdığınızda AI sütununda toplam saati değiştirdikçe o satırdaki mesaileri otomatik olarak dağıtır:

Private Sub Worksheet_Change(ByVal Target As Range)
son = Cells(Rows.Count, "AI").End(3).Row
If Intersect(Target, Range("AI4:AI" & son)) Is Nothing Then Exit Sub

toplam = Target.Value
    gün = 0
    For j = 5 To 34
        If WorksheetFunction.IsNonText(Cells(Target.Row, j)) = True Or Cells(Target.Row, j) = "" Then
            gün = gün + 1
            Cells(Target.Row, j) = ""
        End If
    Next
    mesai = WorksheetFunction.RoundUp(toplam / gün, 0)
    For k = 5 To 34
        If WorksheetFunction.IsNonText(Cells(Target.Row, k)) = True Or Cells(Target.Row, k) = "" Then
        Cells(Target.Row, k) = WorksheetFunction.Min(mesai, toplam - WorksheetFunction.Sum(Range(Cells(Target.Row, "E"), Cells(Target.Row, "AH"))))
        End If
    Next
End Sub

 

[yrmzjojuk]

çok teşekkürler istediğim tablo tamda buydu yanlız ufak sorunu tek satırda hep aynı sayıyı atıyor ve bıtınce kalan satırlara 0 atıyor aynı sayı yerıne sürekli farklı farklı sayılar atamasını saglayabılırmıyız ve sıfır ibaresini hiç baz almaya bilirmiyiz boş olabilir direk

son durum

 

[YUSUF44]

Maalesef ben bundan fazlasını yapamam.

 

[yrmzjojuk]

çözümü varmıdır yoksa en olacağı bumudur bilen arkadaşlar yardımcı olabilirlermi

 

[merakli_72]

selam,
eki inceleyiniz

 

[yrmzjojuk]

selam,
eki inceleyiniz

bunu kendi dosyamıza nasıl uygularız hocam uygulayamadımda

 

[merakli_72]

Selam,
aşağıdaki kodu ilgili sayfanın kod kısmına yapıştırınız

'Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Son_Sat, EklE As Integer
Dim i, Tp_Mes, Hd_Sut As Byte


Son_Sat = Cells(Rows.Count, "AI").End(3).Row
If Intersect(Target, Range("AI4:AI" & Son_Sat)) Is Nothing Then Exit Sub
Randomize Timer
    For i = 5 To 34
        If IsNumeric(Cells(Target.Row, i)) Then
            Cells(Target.Row, i) = Int(8 * Rnd)
            If Cells(Target.Row, i) = 0 Then Cells(Target.Row, i) = ""
        End If
    Next
    
Hd_Sut = 5
Do While Tp_Mes <> Cells(Target.Row, "AI")
If IsNumeric(Cells(Target.Row, Hd_Sut)) Then
    Tp_Mes = Application.WorksheetFunction.Sum(Range(Cells(Target.Row, "E"), Cells(Target.Row, "AH")))
    'Hd_Sut = Int((34 - 5 + 1) * Rnd + 5)
    
    If Tp_Mes > Cells(Target.Row, "AI") And Cells(Target.Row, Hd_Sut) > 0 Then
        Cells(Target.Row, Hd_Sut) = Cells(Target.Row, Hd_Sut) - 1
    ElseIf Tp_Mes < Cells(Target.Row, "AI") And Cells(Target.Row, Hd_Sut) < 7 Then
        Cells(Target.Row, Hd_Sut) = Cells(Target.Row, Hd_Sut) + 1
    End If
    
    If Cells(Target.Row, Hd_Sut) = 0 Then Cells(Target.Row, Hd_Sut) = ""
    
End If
    
    
    Hd_Sut = Hd_Sut + 1
    If Hd_Sut > 34 Then Hd_Sut = 5
Loop

End Sub

 

[yrmzjojuk]

çok teşekkür ederim gerçektende

 

[yrmzjojuk]

konuyu horlatacagım ama aynı tablonun 31günlük olanını yapamadım arkadaşlar bir türlü 30olarak mevcut ama kodlarıyla oynayıp yapmaya çalıştım ama bir türlü sonuc alamadım çalıştıgım tabloyu ek olarak ektedim aynı 31gün oldugu için 30gün için olan tabloyu buna uyarlayamadım bir türlü bide sizden ufak bir ricam daha var konuyla ilgili mesela günlere 1de atıyor 2 ve 8 arası otomatik sayı atanacak şekilde nasıl duzenleriz yardımcı olabilirmisiniz arkadaşlar