• DİKKAT

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

Okul Nöbet Programı

S

sahika51

Altın Üye
Katılım
28 Ekim 2006
Mesajlar
187
Excel Vers. ve Dili
2010-2019
İyi günler. Forumda epey aradım ama tam istediğim gibi veya dönüştürebileceğim bir program bulamadım. Bende bir nöbet programı yapmaya çalıştım ama takıldım. Açıklamayı programın içine yazdım. Bunlar için bir buton ve makro yapılabilir mi? Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

İşgünleri durumunu hallettim diğer tarafları sayın ustalardan bekliyorum.
 

Ekli dosyalar

Hayırlı akşamlar. Program konusunda henüz yardım alamadım ama programda makro kaydet yöntemiyle makro oluşturabildim ancak tam istediğim gibi olmadı. Programa bakarsanız şayet ilk günümüz pazartesi hariç diğer günler ile başlarlarsa kişilerin nöbet günleri değişiyor. Bu da istemediğimiz bir durum. Bizim istediğimiz c8 den c 50 ye kadar kişilerin karşısındaki d8 d50 deki günleri ne ise tabloya ona göre dağıtması gerekiyor.
Örneğin hafta pazartesi ile başlarsa problem olmuyor ama salı günü başlarsa Hasan ile başlaması gereken tablo Ahmet ile başlıyor gibi. Epeydir uğraşıyorum ama yapamadım. Yardım!!!!
 

Ekli dosyalar

Sayın @sahika51 ,
Şimdiye kadar sizin geliştirdiğiniz kodların daha düzenli hale getirilmesi ve istediğiniz sonucu alabilmeniz için;
bazı şartların, kuralların ve seçeneklerin belirlenmesinde fayda var.
Örnek:
25 günlük nöbet programında, mevcut sayfanızda 20kişi varsa nöbet sistemi nasıl devam etmelidir?
25 kişiden fazla olduğunda 25 günlük nöbet programı nasıl olmalıdır?

Bu konuda detaylı açıklama yaparsanız ve eğer (makro ile değil) el ile düzenlenmiş örneklerinizi forumda paylaşırsanız;
daha kısa sürede doğru çözüm bulabilirsiniz.
Not: Nöbet sistemleri her zaman çözümü kolay olmayan ve özel bilgiler gerektiren uygulamalardır.
 
D sutünundaki günleri İlk harfi büyük diğer harfleri küçük olarak yazınız. aşağıdaki gibi

Pazartesi
Salı
Çarşamba
Perşembe
Cuma


Kod:

PHP: 
Sub deneme1()


son = Worksheets("devamsızlık").Cells(Rows.Count, "H").End(3).Row

Sheets("devamsızlık").Range("H13:P" & son).ClearContents


Dim tarih1 As Date

tarih1 = Worksheets("devamsızlık").Cells(1, "d").Value
tarih2 = Worksheets("devamsızlık").Cells(3, "d").Value
sat = 13
For i = 0 To Abs(CDbl(tarih2 - tarih1))

If Format(CDate(tarih1 + i), "dddd") = "Cumartesi" Then GoTo atla1
If Format(CDate(tarih1 + i), "dddd") = "Pazar" Then GoTo atla1
Worksheets("devamsızlık").Cells(sat, "h").Value = CDate(tarih1 + i)
Worksheets("devamsızlık").Cells(sat, "I").Value = Format(CDate(tarih1 + i), "dddd")
sat = sat + 1
atla1:
Next


sut1 = 3
sut2 = 10

For i = 8 To Worksheets("devamsızlık").Cells(Rows.Count, "D").End(3).Row Step 4
aranan1 = Worksheets("devamsızlık").Cells(i, "D").Value

For j = 13 To Worksheets("devamsızlık").Cells(Rows.Count, "I").End(3).Row
bulunan1 = Worksheets("devamsızlık").Cells(j, "I").Value
If aranan1 = bulunan1 Then

Worksheets("devamsızlık").Cells(j, sut2).Value = Worksheets("devamsızlık").Cells(i, sut1).Value
Worksheets("devamsızlık").Cells(j, sut2 + 2).Value = Worksheets("devamsızlık").Cells(i + 1, sut1).Value
Worksheets("devamsızlık").Cells(j, sut2 + 4).Value = Worksheets("devamsızlık").Cells(i + 2, sut1).Value
Worksheets("devamsızlık").Cells(j, sut2 + 6).Value = Worksheets("devamsızlık").Cells(i + 3, sut1).Value

End If

Next j

Next i

MsgBox "işlem tamam"

End Sub
 
Halit3 yardımın için teşekkür ederim. Kişi ve günler doğru çalışıyor. Ancak Kişileri her hafta farklı bölgelere vermesi gerekiyor. Örnek verecek olursak;
3 eylül Pazartesi günü Ahmet 1. bölgede nöbet tutuyorsa, Ahmet 10 Eylül Pazartesi Günü 2. bölgede nöbet tutmalı, 17 Eylül Pazartesi 3. Bölgede nöbet tutmalı, 24 Eylül Pazartesi 4. Bölgede nöbet tutmalı 1 Ekim Pazartesi yeniden 1. bölge de nöbet tutmalı, Yani her hafta nöbet yerlerinin değişmesi gerekiyor.
Birde sonradan fark ettim E sütununda günleri karışık verdiğim zaman örnek perşembe, Salı , Cuma, Pazartesi gibi program tabloya atama yapmıyor.
 
Son düzenleme:
turist' Alıntı:
Sayın @sahika51 ,
Şimdiye kadar sizin geliştirdiğiniz kodların daha düzenli hale getirilmesi ve istediğiniz sonucu alabilmeniz için;
bazı şartların, kuralların ve seçeneklerin belirlenmesinde fayda var.
Örnek:
25 günlük nöbet programında, mevcut sayfanızda 20kişi varsa nöbet sistemi nasıl devam etmelidir?
25 kişiden fazla olduğunda 25 günlük nöbet programı nasıl olmalıdır?

Bu konuda detaylı açıklama yaparsanız ve eğer (makro ile değil) el ile düzenlenmiş örneklerinizi forumda paylaşırsanız;
daha kısa sürede doğru çözüm bulabilirsiniz.

Sevgili turist,ilgine çok teşekkür ederim.
Aslında 2. mesajımda gönderdiğim programda manuel makro kaydı yaptım tam olarak o şekilde dağıtım yapması gerekiyor.
Dikkat edersen 1. hafta 1. bölgedeki kişiler 2. hafta farklı bir bölgeye kayıyor.
**25 günlük nöbet programında 5. hafta tekrar 1. hafta ile aynı olmalı
**25 kişiden fazla olduğunda biz c sütunundaki hücrelere bazı günlere 2 kişi yazabiliyoruz. Böylece sorun olmuyor.
Genişletmek için tıkla ...
 
İlk üç mesajınızda bunlar yazmıyordu
 
Programın içinde yazıyordu aslında ama muhtemelen farkedemediniz.
 
uzun bir kod oldu
kodun mantığı C8:C27 hücrelerindeki verileri alarak kaydırıp I:P sutülarına aktarıyor tarih ile hiç ilgisi yok kodların
PHP: 
Sub deneme3()


ReDim ara1(20): ReDim ara2(20): ReDim ara3(20): ReDim ara4(20): ReDim ara5(20):


For i = 8 To 27
ara1(i - 7) = Cells(i, 3).Value
Next


ekle = 7
k = 0
For i = 1 To 5
ara2(k + 1) = Cells(ekle + 4, 3).Value
ara2(k + 2) = Cells(ekle + 1, 3).Value
ara2(k + 3) = Cells(ekle + 2, 3).Value
ara2(k + 4) = Cells(ekle + 3, 3).Value
k = k + 4
ekle = ekle + 4
Next i

ekle = 7
k = 0
For i = 1 To 5
ara3(k + 1) = Cells(ekle + 3, 3).Value
ara3(k + 2) = Cells(ekle + 4, 3).Value
ara3(k + 3) = Cells(ekle + 1, 3).Value
ara3(k + 4) = Cells(ekle + 2, 3).Value
k = k + 4
ekle = ekle + 4
Next i

ekle = 7
k = 0
For i = 1 To 5
ara4(k + 1) = Cells(ekle + 2, 3).Value
ara4(k + 2) = Cells(ekle + 3, 3).Value
ara4(k + 3) = Cells(ekle + 4, 3).Value
ara4(k + 4) = Cells(ekle + 1, 3).Value
k = k + 4
ekle = ekle + 4
Next i

ekle = 7
k = 0
For i = 1 To 5
ara5(k + 1) = Cells(ekle + 1, 3).Value
ara5(k + 2) = Cells(ekle + 2, 3).Value
ara5(k + 3) = Cells(ekle + 3, 3).Value
ara5(k + 4) = Cells(ekle + 4, 3).Value
k = k + 4
ekle = ekle + 4
Next i



sat = 13

sut = 10
For i = 13 To 32
Cells(sat, sut).Value = ara1(i - 12)
sut = sut + 2
If sut = 18 Then
sut = 10
sat = sat + 1
End If
Next i


sut = 10
For i = 13 To 32
Cells(sat, sut).Value = ara2(i - 12)
sut = sut + 2
If sut = 18 Then
sut = 10
sat = sat + 1
End If
Next i


sut = 10
For i = 13 To 32
Cells(sat, sut).Value = ara3(i - 12)
sut = sut + 2
If sut = 18 Then
sut = 10
sat = sat + 1
End If
Next i

sut = 10
For i = 13 To 32
Cells(sat, sut).Value = ara4(i - 12)
sut = sut + 2
If sut = 18 Then
sut = 10
sat = sat + 1
End If
Next i

sut = 10
For i = 13 To 32
Cells(sat, sut).Value = ara5(i - 12)
sut = sut + 2
If sut = 18 Then
sut = 10
sat = sat + 1
End If
Next i

MsgBox "işlem tamam"
End Sub
 
Teşekürler Halit3. Tarih bölümünü ekledim. Bu şekilde kullanılabilir. Programın şimdilik son halini buraya atayım.
Bu haliyle program c8:c50 deki sıralamaya göre dağıtım yapıyor. c8:c50 nin karşısındaki günlerin bir önemi yok.
Eğer biz d8:50 deki günleri karışık dahi atsak yani pazartesi, perşembe,cuma,pazartesi,salı,cuma,çarşamba..... Dağıtım işi c8:c50 değer karşısındaki D8:D50 hangi günü görüyorsa ona göre dağıtım yapsa...
 

Ekli dosyalar

Dosyaya bir adet veri sayfası ekledim
Veri sayfasındaki isimleri değiştirin veya isimlerin karşısındaki günleri değiştirin aktar düğmesine tıklayınız daha sonra devamsızlık sayfasından aktarımı yapınız.
 

Ekli dosyalar

Ya
PHP: 
Private Sub CommandButton1_Click()

Sheets("devamsızlık").Range("C8:C31").ClearContents

ReDim ara1(30)

For i = 8 To Worksheets("devamsızlık").Cells(Rows.Count, "D").End(3).Row
ara1(i - 7) = 1
Next i

For j = 2 To Worksheets("veri").Cells(Rows.Count, "c").End(3).Row
aranan1 = Worksheets("veri").Cells(j, "c").Value

For i = 8 To Worksheets("devamsızlık").Cells(Rows.Count, "D").End(3).Row
bulunan1 = Worksheets("devamsızlık").Cells(i, "D").Value
If ara1(i - 7) = 1 Then
If aranan1 = bulunan1 Then
Worksheets("devamsızlık").Cells(i, 3).Value = Worksheets("veri").Cells(j, 2).Value
ara1(i - 7) = 0
Exit For
End If

End If
Next i
Next j

MsgBox "işlem tamam"

End Sub
zmış olduğum veri sayfasındaki kodu bununla değiştir.
 
Teşekürler halit3 ilgilendiniz zahmet oldu. kullanmak isterler diye programın son halini atayım
 

Ekli dosyalar

Eklemiş olduğunuz dosyada kod bölümünde gereksiz modüle ve userformları silerseniz iyi olacaktır.
 
Herhalde yanlış dosyayı eklediniz. dosyanız hiç küçülmemiş
ben ekliyorum.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst