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

NeCRiS · 30 Ekim 2024

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.

WeTransfer | Send Large Files Fast - Up To 2GB Free

The simple, quick and secure way to send your files around the world without an account. Share your files, photos, and videos today for free.

we.tl

md3m1ray · 30 Ekim 2024

merhaba sizin dosyanızı indiremedim

yanginci34 · 30 Ekim 2024

Arkadaşın dosyası

NeCRiS · 30 Ekim 2024

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 · 30 Ekim 2024

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

NeCRiS · 30 Ekim 2024

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 · 30 Ekim 2024

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 · 30 Ekim 2024

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 · 30 Ekim 2024

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 · 30 Ekim 2024

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 · 31 Ekim 2024

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 · 31 Ekim 2024

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 · 31 Ekim 2024

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 · 31 Ekim 2024

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 · 31 Ekim 2024

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 · 31 Ekim 2024

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

Teşekkürler hocam

md3m1ray · 31 Ekim 2024

deneme firsatiniz oldu mu acaba

halit3 · 31 Ekim 2024

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 · 1 Kasım 2024

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 · 1 Kasım 2024

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

WeTransfer | Send Large Files Fast - Up To 2GB Free

md3m1ray

yanginci34

Ekli dosyalar

NeCRiS

haliliyas

NeCRiS

haliliyas

NeCRiS

md3m1ray

NeCRiS

md3m1ray

NeCRiS

haliliyas

haliliyas

md3m1ray

haliliyas

md3m1ray

halit3

Uzman

Ekli dosyalar

haliliyas

haliliyas