• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

  • Konbuyu başlatan Konbuyu başlatan NeCRiS
  • Başlangıç tarihi Başlangıç tarihi
N

NeCRiS

Katılım
30 Ekim 2024
Mesajlar
6
Excel Vers. ve Dili
Plus 2021 - Türkçe
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

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 we.tl
 
Son düzenleme:
merhaba sizin dosyanızı indiremedim
 
Son düzenleme:
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
Genişletmek için tıkla ...
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ı.
 
iyi günler
ilk mesajdaki dosyayı indirdim ama müsait olduğu günler nerede yazıyor bulamadım?
 
haliliyas' Alıntı:
iyi günler
ilk mesajdaki dosyayı indirdim ama müsait olduğu günler nerede yazıyor bulamadım?
Genişletmek için tıkla ...
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
 
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
 
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' Alıntı:
Eyvallah hocam bekliyorum.
Genişletmek için tıkla ...


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.

254249
254250
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
 
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
Genişletmek için tıkla ...

Çok teşekkür ederim indirip deneyeceğim, erişim isteği gönderdim dosyaya. İzin verirseniz indireyim.
 
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
 

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
 
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.
 

Ekli dosyalar

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.
Genişletmek için tıkla ...
Hocam eğer sorun olmayacaksa dosyaları harici bir siteye yüklemeniz mümkün mü?
Teşekkür
 
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
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst