Çalışma listesi

[Burakyyy]

Merhabalar,

30 Tane personel,
Haftanın 6 günü
6 kişi çalışacak karışık şekilde,
İki personel ikişer gün peşpeşe çalışacak.

4 haftada bir sıra gelmesi gerekiyor. Formüllü bir şeyler yapabilir miyiz

 

[pitchoute]

Merhaba, size önerim makroyu kullanarak bir başlangıç çizelgesi oluşturun. Oluşan çizelgeyi kontrol edip gerekli düzenlemeleri manuel yapın. 4 haftalık temel çizelge oluşunca bunu saklayın ve her ay tekrar kullanın.

Sub CalismaListesiOlustur()
    Dim ws As Worksheet
    Dim personelSayisi As Integer, gunSayisi As Integer, haftaSayisi As Integer
    Dim p As Integer, g As Integer, h As Integer, sayac As Integer
    Set ws = ActiveSheet
    ws.Cells.Clear
    personelSayisi = 30
    gunSayisi = 6
    haftaSayisi = 4
    
    ws.Range("A1") = "Personel/Tarih"
    For h = 1 To haftaSayisi
        For g = 1 To gunSayisi
            ws.Cells(1, (h - 1) * gunSayisi + g + 1) = "H" & h & "G" & g
        Next g
    Next h
    
    For p = 1 To personelSayisi
        ws.Cells(p + 1, 1) = "Personel " & p
    Next p
    
    Dim calisanlar As Collection
    Set calisanlar = New Collection
    
    For h = 1 To haftaSayisi
        For g = 1 To gunSayisi
            Set calisanlar = New Collection
            
            If g > 1 Then
                sayac = 0
                For p = 1 To personelSayisi
                    If ws.Cells(p + 1, (h - 1) * gunSayisi + g) = "X" Then
                        If g < 3 Or ws.Cells(p + 1, (h - 1) * gunSayisi + g - 1) <> "X" Then
                            If sayac < 2 Then
                                calisanlar.Add p
                                sayac = sayac + 1
                                If sayac = 2 Then Exit For
                            End If
                        End If
                    End If
                Next p
            End If
            Do While calisanlar.Count < 6
                p = (WorksheetFunction.RandBetween(1, personelSayisi))
                On Error Resume Next
                calisanlar.Add p, CStr(p)
                On Error GoTo 0
            Loop
            
            For Each p In calisanlar
                ws.Cells(p + 1, (h - 1) * gunSayisi + g + 1) = "X"
            Next p
        Next g
    Next h
    
    ws.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
    ws.Columns.AutoFit
End Sub