Farklı Müsaitlik Günlerine Göre Nöbet Çizelgesi

NeCRiS · Çarşamba saat 11:38'de

Arkadaşlar merhaba ofiste bi nöbet çizelgesi oluşturmam gerekiyor. 8 kişi haftanın 5 günü ofiste nöbetçi olacak. Ancak herkes müsait günleri farklı. Mesela 2 kişi haftanın tüm günü müsait 3 kişi 3 günü 2 kişi 2 günü gibi. Bunu nasıl yapabiliriz? Ekte yer alan dosyada müsaitlik olmadan yapılmıştır.

Nöbet Listesi.xlsm

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

md3m1ray · Çarşamba saat 13:29'de

merhaba sizin dosyanızı indiremedim

yanginci34 · Çarşamba saat 13:51'de

Arkadaşın dosyası

NeCRiS · Çarşamba saat 13:57'de

md3m1ray' Alıntı:
merhaba sizin dosyanızı indiremedim ama kendim dediklerinize göre bir şey yapmak istiyorum.

"hergün kesin 2 kişi nöbetçi olacak mı yoksa hergün 1 nöbetçi olacak arta kalan 3 kişi rastgele günlere mi dağılacak "
"aynı personel farklı bir gün 2. nöbeti tutabilir mi " gibi sorulara da açıklık getirseniz

Her gün 1 kişi nöbetçi olacak. Aynı personel farklı bir gün 2. nöbeti de tutabilir. Tek kriter 8 nöbetçinin sadece müsait olduğu günlerde nöbet tutması.

haliliyas · Çarşamba saat 14:11'de

iyi günler
ilk mesajdaki dosyayı indirdim ama müsait olduğu günler nerede yazıyor bulamadım?

NeCRiS · Çarşamba saat 14:44'de

haliliyas' Alıntı:
iyi günler
ilk mesajdaki dosyayı indirdim ama müsait olduğu günler nerede yazıyor bulamadım?

Merhaba şöyle hocam;

	MÜSAİT GÜNLERİ
HÜSEYİN	CUMA, ÇARŞAMBA
NURDAN	PAZARTESİ, ÇARŞAMBA, PERŞEMBE
ENGİN	PAZARTESİ, ÇARŞAMBA, PERŞEMBE
SENA	TÜM HAFTA
MUSTAFA	PAZARTESİ, PERŞEMBE
EREN	TÜM HAFTA
ÖZKAN	PAZARTESİ, SALI, ÇARŞAMBA, PERŞEMBE
OSMAN	PAZARTESİ, ÇARŞAMBA, PERŞEMBE

haliliyas · Çarşamba saat 14:49'de

peki C1:M1 aralığındaki sayılar ne işe yarıyor?

TARİH

OFİS NÖBETİ

2

3

4

5

6

7

8

9

10

11

12

NeCRiS · Çarşamba saat 14:55'de

haliliyas' Alıntı:
peki C1:M1 aralığındaki sayılar ne işe yarıyor?

TARİH
OFİS NÖBETİ
2
3
4
5
6
7
8
9
10
11
12

Onların bir önemi yok. Silinebilir.

md3m1ray · Çarşamba saat 17:55'de

excel de değilde kendi yazdığım python nöbet programı vardı kodları size uyarlayıp yarın ofise geçince atayım belki o da işinize yarar

NeCRiS · Çarşamba saat 19:50'de

md3m1ray' Alıntı:
excel de değilde kendi yazdığım python nöbet programı vardı kodları size uyarlayıp yarın ofise geçince atayım belki o da işinize yarar

Eyvallah hocam bekliyorum.

md3m1ray · Perşembe saat 12:18'de

NeCRiS' Alıntı:
Eyvallah hocam bekliyorum.

merhaba
programı düzenledim sizin isteklere göre uyarladım göndereyim test edin eksik, hata veya bu böyle olsa daha iyi olur dediklerinizi yazın uğraşayım.

-Üst kısımda personel kaydetme alanı var, isim girip müsait olduğu günleri seçerek Kişi Ekle butonu ile kaydedilebilir.
-Sonradan isim veya gün değişmek istenirse kişiye tıklayıp üsten tekrar yeni isim ve yeni günler seçilerek Kişi Güncelle butonu ile güncellenebilir.
-Kişiye tıklayıp Kişi Sil butonu ile kişi silinebilir.
-Yıl ve Ay seçilerek ilgili aya ait otomatik olarak çizelge oluşturulur.
-Excel dosyası olarak kaydedecek ve Tarih Gün bilgisi otomatik gelecektir.
-Kişilerin o listede kaç nöbet tuttuğu bilgisi de gelecektir.

Açık kaynak kodları: https://github.com/md3m1ray/NobetAppV2

Dosya boyutu büyük hatası nedeniyle konu ekine yükleyemedim drive yükledim.

Harici indirme linki : https://drive.google.com/file/d/1FC3xw3J4tRkpyesbagHeccJA3xBWllE9/view?usp=drive_link

NeCRiS · Perşembe saat 13:04'de

md3m1ray' Alıntı:
merhaba
programı düzenledim sizin isteklere göre uyarladım göndereyim test edin eksik, hata veya bu böyle olsa daha iyi olur dediklerinizi yazın uğraşayım.

Ekli dosyayı görüntüle 254249
Ekli dosyayı görüntüle 254250
Ekli dosyayı görüntüle 254251

-Üst kısımda personel kaydetme alanı var, isim girip müsait olduğu günleri seçerek Kişi Ekle butonu ile kaydedilebilir.
-Sonradan isim veya gün değişmek istenirse kişiye tıklayıp üsten tekrar yeni isim ve yeni günler seçilerek Kişi Güncelle butonu ile güncellenebilir.
-Kişiye tıklayıp Kişi Sil butonu ile kişi silinebilir.
-Yıl ve Ay seçilerek ilgili aya ait otomatik olarak çizelge oluşturulur.
-Excel dosyası olarak kaydedecek ve Tarih Gün bilgisi otomatik gelecektir.
-Kişilerin o listede kaç nöbet tuttuğu bilgisi de gelecektir.

Açık kaynak kodları: https://github.com/md3m1ray/NobetAppV2

Dosya boyutu büyük hatası nedeniyle konu ekine yükleyemedim drive yükledim.

Harici indirme linki : https://drive.google.com/file/d/1FC3xw3J4tRkpyesbagHeccJA3xBWllE9/view?usp=drive_link

Çok teşekkür ederim indirip deneyeceğim, erişim isteği gönderdim dosyaya. İzin verirseniz indireyim.

haliliyas · Perşembe saat 13:11'de

aağıdaki kodu dener misiniz?
not:dzPersonel = Sayfa1.Range("MusaitPersonel") buradaki Sayfa1.Range("MusaitPersonel") değeri 6. mesajdaki alana denk geliyor

Kod:

Sub ListeYap_2()
If [r2] = "" Or [s2] = "" Then Exit Sub
[a2:B65536].ClearContents

Dim xP, i, xYil, xAyAd, Ay, xAySay, Gun
   xYil = Sayfa1.Range("Yıl")
  xAyAd = UCase(Sayfa1.Range("Ay"))
     Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
 xAySay = WorksheetFunction.Match(xAyAd, Ay, 0)
    Gun = Array("", "", "PAZARTESİ", "SALI", "ÇARŞAMBA", "PERŞEMBE", "CUMA")

Dim xAySon As Byte:     xAySon = Day(DateSerial(xYil, xAySay + 1, 0))
Dim dzTarih() As Variant: ReDim dzTarih(1 To xAySon, 1 To 2)
          
           Dim dzPersonel As Variant:
               dzPersonel = Sayfa1.Range("MusaitPersonel"):
ReDim Preserve dzPersonel(1 To UBound(dzPersonel), 1 To 3)

        For i = 1 To xAySon
             dzTarih(i, 1) = DateSerial(xYil, xAySay, i)
                      xMod = dzTarih(i, 1) Mod 7
             If xMod > 1 Then
             xPerSr = 0: xMin = 100
                For xP = 1 To UBound(dzPersonel)
                   If (InStr(1, dzPersonel(xP, 2), Gun(xMod)) > 0 Or InStr(1, dzPersonel(xP, 2), "HAFTA") > 0) And dzPersonel(xP, 3) < xMin Then
                        xPerSr = xP: xMin = dzPersonel(xP, 3)
                   End If
                Next xP
                dzPersonel(xPerSr, 3) = dzPersonel(xPerSr, 3) + 1
                dzTarih(i, 2) = dzPersonel(xPerSr, 1)
             End If
        Next i
Sayfa1.Range("A2").Resize(xAySon, 2) = dzTarih
End Sub

haliliyas · Perşembe saat 13:17'de

HÜSEYİN	CUMA, ÇARŞAMBA
NURDAN	PAZARTESİ, ÇARŞAMBA, PERŞEMBE
ENGİN	PAZARTESİ, ÇARŞAMBA, PERŞEMBE
SENA	TÜM HAFTA
MUSTAFA	PAZARTESİ, PERŞEMBE
EREN	TÜM HAFTA
ÖZKAN	PAZARTESİ, SALI, ÇARŞAMBA, PERŞEMBE
OSMAN	PAZARTESİ, ÇARŞAMBA, PERŞEMBE

yukardaki alanı MusaitPersonel olarak isimlendirdim, istenirse aktif olarak ilgili sütun/satıra göre de işlem yapılabilir

md3m1ray · Perşembe saat 14:25'de

NeCRiS' Alıntı:
Çok teşekkür ederim indirip deneyeceğim, erişim isteği gönderdim dosyaya. İzin verirseniz indireyim.

rica ederim umarım istediğiniz gibi çalışır.
dosya erişimini herkes yaptım.

haliliyas · Perşembe saat 15:00'de

md3m1ray' Alıntı:
dosya erişimini herkes yaptım.

Teşekkürler hocam

md3m1ray · Perşembe saat 21:19'de

deneme firsatiniz oldu mu acaba

halit3 · Perşembe saat 22:41'de

Alternatif iki adet dosya ekliyorum her iki dosyada aynı sadece birisinin verilerini ben örnek olsun diye aktardım diğeri aktarılmadan olan dosyadır irdeleyiniz.

haliliyas · Cuma saat 10:33'de

halit3' Alıntı:
Alternatif iki adet dosya ekliyorum her iki dosyada aynı sadece birisinin verilerini ben örnek olsun diye aktardım diğeri aktarılmadan olan dosyadır irdeleyiniz.

Hocam eğer sorun olmayacaksa dosyaları harici bir siteye yüklemeniz mümkün mü?
Teşekkür

haliliyas · Cuma saat 13:35'de

kodun son hali aşağıdaki gibidir.
dilerim işinize yarar
Not: :dzPersonel = Sayfa1.Range("MusaitPersonel") buradaki Sayfa1.Range("MusaitPersonel") değeri 6. mesajdaki alana denk geliyor.
Diğer Notlar:
biraz uzadı ama büyük/küçük harf duyarlılığı ve hatalı yazılmış ay adlarında çıkan sorunları düzeltmeye çalıştım
Evaluate("=upper(""" & .... & """)") yada Evaluate("=lower(""" & .... & """)") ifadeleri küçük/büyük harf dönüşümlerinde Türkçe karakterlere yaşanabilecek sorunları ortadan kaldırmak için kullanıldı.
bir de geçmiş aylara ait nöbet kaydı tutulmadığından nöbet çizelgesi oluşturulurken tek aylarda personel listesinde baştan sona çift aylarda sondan başa gidilmiştir

Kod:

Sub ListeYap_4_3_hy() 'Sorunsuz Çalışıyor Büyük/Küçük harf fark etmiyor _hy
If Sayfa1.[r2] = "" Or Sayfa1.[s2] = "" Then Exit Sub
Sayfa1.[a2:B33].ClearContents

Dim xP, i, xYil, xAyAd, Ay, xAySay, Gun
   xYil = Sayfa1.Range("Yıl")
  xAyAd = Evaluate("=upper(""" & Sayfa1.Range("Ay") & """)") ' UCase(Sayfa1.Range("Ay"))
     Ay = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
' xAySay = WorksheetFunction.Match(xAyAd, Ay, 0)
xAySay = Application.Match(xAyAd, Ay, 0)
If Not IsNumeric(xAySay) Then MsgBox "ay adı hatalı girilmiş": Exit Sub
    Gun = Array("", "", "PAZARTESİ", "SALI", "ÇARŞAMBA", "PERŞEMBE", "CUMA")

Dim xAySon As Byte:     xAySon = Day(DateSerial(xYil, xAySay + 1, 0))
Dim dzTarih() As Variant: ReDim dzTarih(1 To xAySon, 1 To 2)
        
           Dim dzPersonel As Variant:
               dzPersonel = Sayfa1.Range("MusaitPersonel"):
ReDim Preserve dzPersonel(1 To UBound(dzPersonel), 1 To 3)

        For i = 1 To xAySon
             dzTarih(i, 1) = DateSerial(xYil, xAySay, i)
                      xMod = dzTarih(i, 1) Mod 7
             If xMod > 1 Then
             xPerSr = 0: xMin = 100
             xBas = LBound(dzPersonel): xBit = UBound(dzPersonel): BaSon = 1
             If (xAySay Mod 2 = 0) Then xBas = UBound(dzPersonel): xBit = LBound(dzPersonel): BaSon = -1
                For xP = xBas To xBit Step BaSon 'UBound(dzPersonel)
                    If (InStr(1, Evaluate("=lower(""" & dzPersonel(xP, 2) & """)"), Evaluate("=lower(""" & Gun(xMod) & """)")) > 0 Or _
                        InStr(1, Evaluate("=lower(""" & dzPersonel(xP, 2) & """)"), Evaluate("=lower(""TÜM HAFTA"")")) > 0) And _
                        dzPersonel(xP, 3) <= xMin Then
                            xPerSr = xP: xMin = dzPersonel(xP, 3)
                            If IsEmpty(xMin) Then GoTo xSonrakiTrh
                    End If
                Next xP
xSonrakiTrh:
                dzPersonel(xPerSr, 3) = dzPersonel(xPerSr, 3) + 1
                dzTarih(i, 2) = dzPersonel(xPerSr, 1)
             End If
        Next i
      
Sayfa1.Range("A2").Resize(xAySon, 2) = dzTarih
End Sub

Farklı Müsaitlik Günlerine Göre Nöbet Çizelgesi

NeCRiS

Nöbet Listesi.xlsm

md3m1ray

yanginci34

Ekli dosyalar

NeCRiS

haliliyas

NeCRiS

haliliyas

NeCRiS

md3m1ray

NeCRiS

md3m1ray

NeCRiS

haliliyas

haliliyas

md3m1ray

haliliyas

md3m1ray

halit3

Uzman

Ekli dosyalar

haliliyas

haliliyas