• DİKKAT

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

Sinav Görevi dağıtım

Katılım
15 Ağustos 2006
Mesajlar
13
Excel Vers. ve Dili
Excel 2002 Türkçe
Personele sınav görevi dağıtım programı lazım. Bu işten anlayan arkadaşlardan ricam şudur.

Birinci tabloda 2 sütünümüz var.

Salon Başkanlığı yapacaklar Gözcülük Yapacaklar

1- Ali Duman 1. Hakan TAŞ
2- İsmail Biçer 2. Deniz SU
3- Ayşe Bahar 3- İsmail AK
... ....... gibi 50'şer isim sıralanmış olsun

Biz binada kaç salon olduğunu gireceğiz. Program salon sayısına göre bu isimlerden rastgele başkan ve gözcü atayacak.

Yardımcı olursanız sevinirim.

Selamlar.
 
Selamlar , beni biraz uğraştırdı ama güzel oldu sanırım. :):keyif: Dosyanız ektedir.

Kod:
Sub aa()
Dim X, xx As Byte, SAYI, SAYI2 As Byte
Set s1 = Sheets("SAYFA1")
Set s2 = Sheets("SAYFA2")
s1.Select
 k = [a65536].End(3).Row
 j = InputBox("Sınıf Sayısı Giriniz")
 
    Columns(5).ClearContents
    Columns(6).ClearContents
    For X = 1 To j
BAŞLA: SAYI = Int((k * Rnd) + 1)
    If WorksheetFunction.CountIf(Columns(5), SAYI) > 0 Or SAYI = 1 Then GoTo BAŞLA
    Cells(X + 1, 5) = SAYI
 
    Next
    For xx = 1 To j
 
devam: SAYI2 = Int((k * Rnd) + 1)
If WorksheetFunction.CountIf(Columns(6), SAYI2) > 0 Or SAYI2 = 1 Then GoTo devam
    Cells(xx + 1, 6) = SAYI2
    Next
s2.Select
[A2:C50].Select
Selection.ClearContents
[A1].Select
For i = 1 To j
Cells(i + 1, 1) = i
Cells(i + 1, 2) = s1.Cells((s1.Cells(i + 1, 5)), 1)
Cells(i + 1, 3) = s1.Cells((s1.Cells(i + 1, 6)), 2)
Next i
s1.Select
  Columns(5).ClearContents
    Columns(6).ClearContents
 
  MsgBox "Sınıflarda Görevli Olanlar Sayfa 2'de Oluşturulmuştur."
  s2.Select
Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("A:A").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B1:C1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
 
End Sub

ÖNEMLİ NOT:Kodları oluştururken Sayın Uzman Korhan Ayhan bey'in daha önceden yazmış olduğu şu sayfadaki kodlarından faydalandım.Kendisine ve diğer uzman arkadaşlara tekrar tekrar teşekkürler.

Not 2: Listede yer alan 100 isim temsilidir ve internetten alınmıştır.
 

Ekli dosyalar

Son düzenleme:
Allah senden razı olsun mesuttasar. Tam aradığım gibi. Acaba Buna küçük bir şey ilave debilir miyiz? Mesela yedek salonlarına yedek gözcü ve başkan seçimi şeklinde. Yine yedek salon sayısını gireceğiz. Ona göre yedek belirleyecek. Ama bir önceki asil karma işiyle aynı anda yapması gerekiyor.

Selamlar
 
Allah senden razı olsun mesuttasar. Tam aradığım gibi. Acaba Buna küçük bir şey ilave debilir miyiz? Mesela yedek salonlarına yedek gözcü ve başkan seçimi şeklinde. Yine yedek salon sayısını gireceğiz. Ona göre yedek belirleyecek. Ama bir önceki asil karma işiyle aynı anda yapması gerekiyor.

Selamlar

İyi dilek ve duaların için çok teşekkür ederim. Allah , bu siteyi kuranlardan ve bize excel i öğretmeye çalışan sayın Uzmanlarımızdan da razı olsun.Sayın semos , dosyanız ektedir.İyi çalışmalar.
 

Ekli dosyalar

Son düzenleme:
Çok teşekkür ederim. Geçmişlerinize rahmet. Tam istediğim gibi.
 
Bir ekleme yapmak istiyorum,
Malum cezaevinde de görev alma durumu var,
Ancak cezaevinde bayanlar görev almıyor.
Bunun için Cinsiyet sütunu eklelip,Bayanların cezaevinde görev almasını önleye bilirmiyiz.
Ozaman güzel olur
 
Geri
Üst