Listeden başka listeye random veri aktarımı

[cevdetmeric1]

Merhaba arkadaşlar,
Günlük olarak nöbet noktası personelini oluşturmak için bir tablo oluşturmaya çalışıyorum.
Sağ taraftaki listede(G3'ten başlayarak tablo sonu belirsiz)
o gün gelecek personelden sol taraftaki listeye(A3'ten başlayarak A7'ye kadar) karışık olarak kişi atamak istiyorum.

Sağdaki tabloda fazladan personel kalması gerekiyor. Random taşıma kodu hakkında fikir verebilir misiniz?
Teşekkür ediyorum.

 

[antonio]

Merhaba,
VBA kod dilinde "rastgele bir sayı oluşturma" anlamında "RND" fonksiyonu kullanılmaktadır. RND fonksiyonu tek başına kullanıldığında Örnek:

Sub rastgele()
    Dim r
    r = Rnd()
    MsgBox r
End Sub

Kodunu çalıştırırsanız, MesajBox size sürekli 0 ile 1 arasında küsuratlı bir sayı üretecektir.
Sıfır ile 24 arasında tamsayı üretilmesi isteniyorsa; yukarıdaki kodu aşağıdaki şekilde revize etmemiz gerekecektir:

Sub rastgele()
    Dim r
    r = Int(25 * Rnd())
    MsgBox r
End Sub

Dikkat edilirse; 0 ile 24 arasında sayı üretmesini istedik, ama 25 rakamı kullandık. Çünkü tamsayı olarak 0 dahil dir (0-24) arasında 25 rakam vardır.
Mevcut kodu; 1 ile 25 arasında tamsayı üretmek üzere değiştirmek için aşağıdaki şekilde düzenleme yapmalıyız:

Sub rastgele()
    Dim r
    r = Int(25 * Rnd() + 1)
    MsgBox r
End Sub

Son Olarak:
Alt ve üst sınırları kullanıcı tarafından belirlenen aralıkta bir tamsayı üretmesi için mevcut kodu tekrar değiştirelim:
Örnek: 15 ile 25 aralığında tamsayı üretmesi hedeflenmiş olsun:
r = Int((ÜstSınır - AltSınır + 1) * Rnd + AltSınır)

Sub rastgele()
    Dim r
    r = Int((25 - 15 + 1) * Rnd() + 15)
    MsgBox r
End Sub

Son olarak; üretilen sayı rastgele isim seçmede, liste oluşturmada nasıl kullanılır:
A- Tüm veriler bir sayfada satır veya sütunlara işlenmişse, rastgele üretilen tamsayı, bu satır veya sütun numarası ile eşleştirilir.
B- Tüm veriler bir dizi içine yerleştirilmiş ise, rastgele üretilen tamsayıya tekabül eden dizi elemanı ile eşleştirilir.
NOT: Dizi elemanları 0 dan başlar. Örnek: 5 elemanlı bir dizinin ilk elamanı 0, son elamanı 4 dür.
VBA.Rnd() ile ilgili anlatımların neredeyse tümü İngilizce olduğundan, bir nebze olsun birilerine faydalı olmak dileklerimle..
Kolay gelsin..

 

[cevdetmeric1]

Anlatımınız için teşekkür ediyorum hocam.
Ancak buradan nasıl bir çözüme ulaşacağımı bulamadım.
dosyam şu linktedir.
https://www.4shared.com/file/uKqS9csAei/NBET_YER.html
buradaki listeler üzerinde random taşımayı nasıl yapabilirim?

 

[antonio]

...
dosyam şu linktedir.
https://www.4shared.com/file/uKqS9csAei/NBET_YER.html
buradaki listeler üzerinde random taşımayı nasıl yapabilirim?

Merhaba,
Bu sitenin dosya indirme linkine tıklandığı zaman açılan sayfanın her yerine "download" butonları yerleştirilmiş, ancak hiçbiri dosya için değil. Her link, bilgisayarınıza alakasız programlar yerleştirmek için çabalıyor. Kısaca virüs dolu, dolayısıyla dosyanızı inceleyemedim. Dosya yükleme siteleri hakkında bilgim olmadığı için bir tavsiyede de bulunamıyorum.

 

[cevdetmeric1]

Merhaba,
sitedeki değişiklikler için bilgim yoktu özür dilerim.
http://www.dosya.tc/server10/nag561/NOBET_YERI.zip.html
adresine yükledim inşaallah buradan rahatça indirebilirsiniz

 

[antonio]

Belirttiğim kodları örnek dosyanıza uyarladım. Fark edeceğiniz üzere, nöbet listesine aynı kişi birden fazla gelmeyecektir. Bunu sağlamak için her çekilişten sonra çıkan kişinin listede varlığı kontrol edilir. Varsa, çekiliş yenilenir ve bu işlem, mükerrer olmayan kişi çekilene kadar devam eder.
Dosyanız ektedir.

 

[cevdetmeric1]

Hocam elinize sağlık yalnız benim altın üyeliğim olmadığı için dosyayı indiremiyorum.

 

[antonio]

Merhaba..
Altın Üyeliğiniz olmadığını gözden kaçırmışım. Şimdi fark ettim. Aşağıdaki kodları kopyalayıp, "Liste Oluşturma" sayfasının sekmesine sağ tıklayarak "Kod Görüntüle" seçeneği ile karşınıza çıkacak pencereye aynen yapıştırınız:

Private Sub CommandButton1_Click()
Dim baylar As Range, bayanlar As Range, sh As Worksheet, bay As Range, bayan As Range, _
    ss_baylar As Long, ss_bayanlar As Long, bay_grv As Integer, bayan_grv As Integer
    
Set sh = ActiveSheet
Set bay = sh.Range("B3:B7")
Set bayan = sh.Range("C3:C7")
ss_baylar = sh.Range("G" & Rows.Count).End(3).Row
ss_bayanlar = sh.Range("H" & Rows.Count).End(3).Row
Set baylar = sh.Range("G3:G" & ss_baylar)
Set bayanlar = sh.Range("H3:H" & ss_bayanlar)
bay_grv = 3 'üçüncü satırdan itibaren çekiliş yapılıyor (baylar için)
bayan_grv = 3 ' üçüncü satırdan itibaren çekiliş yapılıyor. (bayanlar için)
Do
yeniden_bay:
    bay_kim = Int((9 - 3 + 1) * Rnd + 3)
    bulunan_bay = sh.Range("G" & bay_kim).Value
    kontrol_bay = Application.WorksheetFunction.CountIf(bay, bulunan_bay)
        If kontrol_bay > 0 Then GoTo yeniden_bay
    sh.Range("B" & bay_grv).Value = bulunan_bay
    bay_grv = bay_grv + 1
Loop While bay_grv < 8
'========================================
Do
yeniden_bayan:
    bayan_kim = Int((9 - 3 + 1) * Rnd + 3)
    bulunan_bayan = sh.Range("H" & bayan_kim).Value
    kontrol_bayan = Application.WorksheetFunction.CountIf(bayan, bulunan_bayan)
        If kontrol_bayan > 0 Then GoTo yeniden_bayan
    sh.Range("C" & bayan_grv).Value = bulunan_bayan
    bayan_grv = bayan_grv + 1
Loop While bayan_grv < 8
MsgBox "İşlem tamamlandı", vbInformation, "KURA İLE PERSONEL BELİRLEME"
End Sub

 

[cevdetmeric1]

Ellerinize sağlık
çok teşekkür ediyorum

 

[antonio]

Rica ederim. İyi çalışmalar.