Servis listesine ara vardiyaların da eklenmesi

[tahsinanarat]

Private Sub Worksheet_Change(ByVal Target As range)
    If Intersect(Target, [e1]) Is Nothing Then Exit Sub

    Dim BUL As range, _
        Adr As String, _
        sat As Long, _
        sv  As Worksheet
    Set sv = Sheets("PERSONEL")
    Set sb = Sheets("Servis_Bul")
'Suzlerikaldir
    Application.ScreenUpdating = False
    sat = Cells(Rows.Count, "a").End(3).Row
    If sat < 7 Then sat = 7
    range("A7:G" & Rows.Count).Clear
    sat = 6

    With sv.range("E:E")
        Set BUL = .Find(Target.Value, LookIn:=xlValues, LookAt:=xlWhole)
        If Not BUL Is Nothing Then
            Adr = BUL.Address
            Do
                If sv.Cells(BUL.Row, "AF") = Cells(1, 6) Then
                sat = sat + 1
                Cells(sat, "A") = sv.Cells(BUL.Row, "S")
                Cells(sat, "C") = sv.Cells(BUL.Row, "A")
                Cells(sat, "D") = sv.Cells(BUL.Row, "I")
                Cells(sat, "E") = sv.Cells(BUL.Row, "B")
                Cells(sat, "F") = sv.Cells(BUL.Row, "R")
                Cells(sat, "G") = sv.Cells(BUL.Row, "L")
                Cells(sat, "H") = sv.Cells(BUL.Row, "C")
                If Cells(sat, "G") = "Bayan" Then Cells(sat, "E").Font.Color = vbRed
                If Cells(sat, "H") = "SERVİS SORUMLUSU" Then Cells(sat, "F").Font.Color = vbRed
                If Cells(sat, "H") = "SERVİS SORUMLUSU" Then Cells(sat, "D") = Cells(sat, "D") & " (Sorumlu)"
                Columns("F:F").NumberFormat = "[<=9999999]###-####;(###) ###-####"
                Columns("B:B").HorizontalAlignment = xlCenter
                Columns("F:F").HorizontalAlignment = xlCenter
               End If

                Set BUL = .FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> Adr
        End If
    End With
            range("A7:F" & Cells(Rows.Count, 1).End(3).Row).Borders.LineStyle = 1
      For sira = 1 To WorksheetFunction.CountA(range("C1:C65536")) - 1
range("B" & sira + 6) = sira
Next
    srv = range("E1")
Cells(sat + 2, "C") = "NOT: Gece Servis Bilgileri"
'Cells(sat + 3, "C") = WorksheetFunction.VLookup(srv, Worksheets("gece_servisi").range("c2:m70"), 4, False) & " - ( KAPASITE = " & WorksheetFunction.VLookup(srv, Worksheets("gece_servisi").range("c2:m70"), 6, False) & " )"
'Cells(sat + 4, "C") = WorksheetFunction.VLookup(srv, Worksheets("gece_servisi").range("c2:m70"), 2, False)
'Cells(sat + 5, "C") = WorksheetFunction.VLookup(srv, Worksheets("gece_servisi").range("c2:m70"), 3, False)
sb.Select

    Application.ScreenUpdating = True
End Sub

Yukarıdaki kod ile ekli çalışma kitabımdaki Servis Listesi adlı sekmenin E1 hücresinde servis ismini seçtiğimde PERSONEL sayfamdaki E sütununda yazılı Servis isimlerinden AF sütununda yazılı gruplara göre filtreleme yapıp şarta uyanlar servis listeme gelmektedir. Buraya kadar herhangi bir sıkıntı yok.

Gruplar 4 Ana harften oluşmakta olup AF sütununda yazmaktadır (A,B,C,D),
İlaveten AF sütununda ara grup olarak farklı harflerle ifade edilmiş olup Gunluk_icmal sekmesindeki tabloda o günkü tarihe göre belirtilen saat aralığında (K Sutunu) sutunda ana gruplar (A,B,C,D), ana grupların sağındaa ise Ara gurupların harpleri yer almaktadır.
Öğle grubu için (O sutunu9 sütununda ana gruplar (A,B,C,D), sağıda ise Ara gruplar yer almaktadır.
Ara gruplar saadece gün içerisinde sabah, ve öğle vardıyalarında çalışmakta, gece vardiyasına gelmezler.

Olmasını istediğim;
I sütunundaki tarihe bakarak hangi ana grup çalışıyor ise sağındaki harflerin Servis Listesindeki F1 de belirtilen ana gruba göre E1 hücresinde seçilen isim listesine ara vardiya gruplarında çalışan isimlerinde listeye eklenmesini listeye gelen ismin sağında parantez içerisinde o ara vardiyayı ifade eden harfin çıkmasını istiyorum.

Örneğimizde; bugün ayın 12 si Sabahleyin B ana grubu, L,K,S ara gurupları ile çalışıyor, o gün için bu servise saadece L ara gurubunda çalışan
TAHSİN ANARAT480 isimli personelin de listeye eklensin.
(O sütunundaki ana grup içinde aynı kriterler geçerli, yani ayın 12 sinde gelecek olan C grubunu seçtiğimizde varsa ara vardiyadaki kişilerde listeye eklenmesini)

Yardımcı olacak üstatlarıma şimdiden teşekkür ederim.

 

[tahsinanarat]

Konu günceldir