Nöbet Listesi Çarşaf Liste oluşturma

[musaagac]

Arkadaşlar ekte göndermiş olduğum çalışmada nöbet listesinde yazılı olan isimleri çarşam listeye aktararak çarşaf listede hangi tarihte nöbet tutmuşsa,

(Hafta içi nöbet tutmuşsa 8, cuma ve Pazar Tutmuşsa 16 Cumartesi tutmuşsa 24 yazacak. Resmi tatiller bir gün ise 16, birgünden fazla ise ilk gün ve son 16 diğer günler 24 olarak yazmasını istiyorum bu konuda yardımcı olurmusunuz.

 

[Necdet]

Merhaba,

Nöbet Listesi sayfasında Tarihin günlerini sildim ve tarihi günlü olarak gösterdim.

Tatil Günlerini Tam deneyemedim, siz deneyiniz.

Tatil Günleri için yeni bir sayfa açtım ve 2011 yılının tatil günlerini orada tanıttım.

Yarım gün olanlar için birşey yapmadım.

Sub Liste()
    Dim sh_n    As Worksheet, _
        sh_c    As Worksheet, _
        sh_t    As Worksheet, _
        Bul     As Range, _
        i       As Integer, _
        Nobet1  As Integer, _
        Nobet2  As Integer, _
        Kolon   As Integer, _
        Saat    As Integer

    Set sh_n = Sheets("Nöbet Listesi")
    Set sh_c = Sheets("Çarşaf Liste")
    Set sh_t = Sheets("Tatil Günleri")
    sh_c.Select
    i = Cells(Rows.Count, "A").End(3).Row
    If i > 10 Then Range("A11:AI" & i).ClearContents
    For i = 7 To sh_n.Cells(Rows.Count, "B").End(3).Row
        
        Set Bul = Range("B:B").Find(sh_n.Cells(i, "C"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Nobet1 = Bul.Row
        Else
            Nobet1 = Cells(Rows.Count, "B").End(3).Row + 1
            Cells(Nobet1, "B") = sh_n.Cells(i, "C")
        End If
        
        Set Bul = Range("B:B").Find(sh_n.Cells(i, "D"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Nobet2 = Bul.Row
        Else
            Nobet2 = Cells(Rows.Count, "B").End(3).Row + 1
            Cells(Nobet2, "B") = sh_n.Cells(i, "D")
        End If
        
        Kolon = Day(sh_n.Cells(i, "B")) + 3
        Set Bul = sh_t.Range("C:C").Find(sh_n.Cells(i, "B"), LookIn:=xlValues)
        If Not Bul Is Nothing Then
            If sh_t.Cells(Bul.Row, "B") = "1 GÜN" Then
                Saat = 24
            ElseIf sh_t.Cells(Bul.Row, "B") = "1. GÜN" Or sh_t.Cells(Bul.Row, "B") = "SON GÜN" Then
                Saat = 16
            Else
                Saat = 24
            End If
        Else
            If Weekday(sh_n.Cells(i, "B"), vbMonday) = 5 Or Weekday(sh_n.Cells(i, "B"), vbMonday) = 7 Then
                Saat = 16
            ElseIf Weekday(sh_n.Cells(i, "B"), vbMonday) = 6 Then
                Saat = 24
            Else
                Saat = 8
            End If
        End If
        Cells(Nobet1, Kolon) = Saat
        Cells(Nobet2, Kolon) = Saat
    Next i
    Range("A11") = 1
        
    Range("AI11").FormulaR1C1 = "=SUM(RC[-31]:RC[-1])"
    i = Cells(Rows.Count, "B").End(3).Row
    
    If i > 10 Then
        Range("AI11:AI" & i).FillDown
        Range("A11:A" & i).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
            Step:=1, Trend:=False
    End If
End Sub

 

[benli58]

sayın musaagac;
necdet hocam makro ile çözmüş. bende formülle bir çözüm oluşturdum. kolay gelsin.