• DİKKAT

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

Nöbet Sistemi ( Kişi sayısı bazında)

Katılım
5 Şubat 2016
Mesajlar
274
Excel Vers. ve Dili
Office 365 Türkçe
Arkadaşlar herkese merhabalar. Benim nöbet sistemine ihtiyacım var. Şöyle ki; örnek vermek gerekirse 60 kişi var bunları otomatik hergün 3 farklı nöbet yerine yerleştirecek. Nöbetler 18:30 da başlayarak 2 saat sürecek şekilde ve 24 saat sürüyor,12 tur yani. Burada amaç hak geçmemesi açısından kişilere mükerrer nöbet yazmaması yani isim sırası ile çekip yazacak.Nöbetçi isimlerini sayfa 2 ye yazmak istiyorum isimleri oradan çeksin.Ve bazı kişileride sadece gece nöbetlerine yazacak onlar sayfa 2 de hücre rengi değişik bir yer olup orayada yazabiliriz. Umarım az çok istediğimi anlatabilmişimdir. Esas sorun teşkil eden noktaya gelince bilgisayardaki yetki kısıtlamasından dolayı dosya indirme yahut yükleme yapamıyorum. Eğer bakma imkanınız olur ise kod şeklinde yazarsanız ben excel açıp oraya uygulayacağım. Şimdiden çok teşekkür ederim.
 
Slm ornek dosyanızı ekleyiniz dosyanızıda biz mi hazırlayalım ?
 
Slm ornek dosyanızı ekleyiniz dosyanızıda biz mi hazırlayalım ?

Merhabalar. Yukarıda yazmıştım örnek dosya verememe sebebimi. Askeri bilgisayar yani kara ağı olduğu için hazırlasanız bile indiremeyeceğim, yahut indirip flash ile atamayacağım o sebep ile kod şeklinde yardım rica etmiştim. Yoksa örnek dosya bende vermek istiyorum. Yanlış anlaşılmasın.
 
Sub Nöbet()
Application.ScreenUpdating = False
For a = 1 To 5
Range("D3:F14") = ""
For i = 4 To 6
Cells(4, 10) = Cells(2, i).Value
For j = 3 To 14
Cells(4, 9) = Cells(j, 3)
Range("AA3:AB62") = Range("L3:M62").Value
Range("AA3:AB62").Sort Range("AB3"), 1
Cells(j, i) = Range("AA3").Value
x = WorksheetFunction.Match(Range("AA3"), Range("L3:L62"), 0) + 3
Sheets("Data").Cells(x, Range("I5") + Range("J5") + 2) = Sheets("Data").Cells(x, Range("I5") + Range("J5") + 2) + 1
Next
Next
Set n = Sheets("Nöbet Listesi")
aa = a * 12 - 9
n.Range("D" & aa & ":F" & aa + 11) = Range("D3:F14").Value
n.Cells(aa, 2) = Range("D17") + a - 1
Next
Set n = Nothing
End Sub

Kod kısmı bu.
 
Resimleri inceleyin
 

Ekli dosyalar

  • 205.jpg
    205.jpg
    260.4 KB · Görüntüleme: 9
  • 206.jpg
    206.jpg
    9.8 KB · Görüntüleme: 4
  • 207.jpg
    207.jpg
    121.7 KB · Görüntüleme: 6
Son 3 resim oluştur sayfasında
 

Ekli dosyalar

  • 208.jpg
    208.jpg
    27.1 KB · Görüntüleme: 7
  • 209.jpg
    209.jpg
    142 KB · Görüntüleme: 4
Geri
Üst