Otomatik Nöbet Çizelgesi Hazırlama

  • Konuyu başlatan Konuyu başlatan cahan2010
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
@cahan2010
Şu kodu kullanabilirsiniz.

VBA:
Sub AYLIK_NOBET_LISTESI()

Set s1 = Sheets("Table 1"): Set s2 = Sheets("Sayfa1")

ay = Month(s1.[D3]): sonsut = s1.Cells(3, Columns.Count).End(xlToLeft).Column
For u = sonsut To 1 Step -1
    If IsDate(s1.Cells(3, u)) Then
        If Month(s1.Cells(3, u)) = ay Then: sonsut = u: Exit For
    End If: Next
tarihler = s1.[D3].Resize(1, u - 3).Value2
saatler = s1.[D5].Resize(1, u - 3).Value
personel = s1.Range("A6:A" & s1.[A5].End(xlDown).Row).Value
veri = s1.[D6].Resize(UBound(personel), u - 3).Value
s2.Range("C5:E" & Rows.Count).Clear: s = 5
s2.Range("C5:C" & Rows.Count).NumberFormat = "d mmmm yyyy dddd"
For sut = 1 To UBound(veri, 2)
    For sat = 1 To UBound(veri)
        If veri(sat, sut) = "N" Then
            s2.Cells(s, 3) = tarihler(1, sut)
            s2.Cells(s, 4) = Replace(saatler(1, sut), Chr(10), "")
            s2.Cells(s, 5) = personel(sat, 1)
            s = s + 1: Exit For
        End If
    Next: Next: s2.Columns("C:E").AutoFit: sonsatir = s2.Cells(Rows.Count, 3).End(3).Row
s2.Range("C5:E" & sonsatir).Borders.LineStyle = 1

End Sub
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst