Random Kura Yapmak

[Fath]

Merhaba arkadaşlar,
Random çekilişlerle ilgili pek çok konu olduğunun farkındayım ama kendi dosyama uyarlamayı başaramıyorum. Evvelce ulaştığımız bir çözüm ise, ihtiyaçların değişmesi sebebiyle kullanılamaz duruma geldi. Vaktim çok çok kısıtl ı .Yardımınıza ihtiyacım var.
Ekli dosyanın "Kişi Verileri" sayfasında adları, soyadları, ve kod harfleri yazılan kişileri, "Çekiliş Tablosu" sayfasının "E" sütununa yazdırmak istiyorum.
Kurallar:
1- "ÇT" E sütununa yazdırılacak ismi "KV" sayfasındaki kod harfine göre atayacak. Bir başka anlatımla, kişi dağıtımındaki temel ölçüt kod harfleri olacak.
2- Kişilerden bazıları rastgele bazıları ise belirlenmiş bir yere dağıtılacak -ismin karşısına random dağıtılacağını belirtmek için "0" yazabiliriz. Diğerlerine ise atanması gereken satırı yazarak çözebileceğimizi düşünüyorum.).
3-Bir kişi tabloya birden fazla kez yazılmayacak.
Çözüme ulaşmaya çalışırken yapılması teklif edilebilecek her türlü öneriye açığım; dosyada çözüme yönelik değişiklikler yapmakta bir sakınca görmüyorum. Anlaşılmayan bir nokta olursa bilgi verebilirim. İlginiz için teşekkür ederim.
Ekleme: OFfice sürümü 2007-Türkçe

 

[veyselemre]

Sub aktar()
    Sheets("Kişi Verileri").Select

    son = Cells(Rows.Count, 2).End(3).Row

    For i = 2 To son
        Cells(i, 5) = i - 1
    Next i

    For i = 2 To son
        ver = Cells(i, 4)
        If ver <> 0 Then Cells(ver + 1, 5) = ""
    Next i

    For i = 2 To son
        ver = Cells(i, 4)
        If ver <> 0 Then Cells(ver + 1, 5).Delete Shift:=xlUp
    Next i


    For i = 1 To 100
        For ii = 2 To son
            If Cells(ii, 5) <> "" Then
                sayi = uret(son)
                If Cells(sayi + 1, 5) <> "" Then
                    ara = Cells(sayi + 1, 5)
                    Cells(sayi + 1, 5) = Cells(ii, 5)
                    Cells(ii, 5) = ara
                End If
            End If
        Next ii
    Next i

    For i = 2 To son
        ver = Cells(i, 4)
        If ver = 0 Then
            Cells(i, 6) = Cells(i, 5)
        Else
            Cells(i, 5).Insert Shift:=xlDown
            Cells(i, 6) = Cells(i, 4)
        End If
    Next i
End Sub
Function uret(son)
basla:
    sayi = Int((son * Rnd) + 1)
    If sayi > son Then GoTo basla
    uret = sayi
End Function

 

[Fath]

Deniyorum Hocam, sağolun.

 

[Fath]

Hocam bir takım sayılar uretip e ve f sütunlarına atıyor. Amaca ulaşamadık. Elinize sağlık, yine emek vermişsiniz.

 

[veyselemre]

Hocam bir takım sayılar uretip e ve f sütunlarına atıyor. Amaca ulaşamadık. Elinize sağlık, yine emek vermişsiniz.

F sütündaki rakamlar, bir takım sayı değil aktarılacak satırlar. Satırlara aktarma işini siz yaparsınız diye yazmamıştım.

Sub aktar()
    Set sV = Sheets("Kişi Verileri")
    Set sT = Sheets("Çekiliş Tablosu")
    sV.Select

    son = Cells(Rows.Count, 2).End(3).Row

    For i = 2 To son
        Cells(i, 5) = i - 1
    Next i

    For i = 2 To son
        ver = Cells(i, 4)
        If ver <> 0 Then Cells(ver + 1, 5) = ""
    Next i

    For i = 2 To son
        ver = Cells(i, 4)
        If ver <> 0 Then Cells(ver + 1, 5).Delete Shift:=xlUp
    Next i


    For i = 1 To 100
        For ii = 2 To son
            If Cells(ii, 5) <> "" Then
                sayi = uret(son)
                If Cells(sayi + 1, 5) <> "" Then
                    ara = Cells(sayi + 1, 5)
                    Cells(sayi + 1, 5) = Cells(ii, 5)
                    Cells(ii, 5) = ara
                End If
            End If
        Next ii
    Next i

    For i = 2 To son
        ver = Cells(i, 4)
        If ver = 0 Then
            Cells(i, 6) = Cells(i, 5)
        Else
            Cells(i, 5).Insert Shift:=xlDown
            Cells(i, 6) = Cells(i, 4)
        End If
    Next i

    For i = 2 To son
        sira = Cells(i, 6)
        sT.Cells(sira + 1, "C") = Cells(i, "C")
        sT.Cells(sira + 1, "E") = Cells(i, "B")
    Next i

    sT.Select

End Sub
Function uret(son)
basla:
    sayi = Int((son * Rnd) + 1)
    If sayi > son Then GoTo basla
    uret = sayi
End Function

 

[turist]

Sayın Fath
Ekli Dosyayı deneyin.
Daha önceki sorunuzu cevaplayan Sayın Ömer BARAN'ın çalışması üzerine düzenleme yapılmıştır.
Kendisi de mutlaka bu konuda cevap verecektir.Şimdiden anlayışı ve çalışmaları için teşekkür ederim.

 

[Fath]

Merhaba,
Veyselemre Bey, kodu çalıştırdım ancak kişi sayfasından herhangi bir veri çekme işlemi gerçekleşmedi. Bazı iş yeri isimleri ve karşısında da sayılar yazdırdı. Emeğinize sağlık; benim için yoruldunuz. Hakkınızı helal edin.
Sayın Turist, dosyayı inceledim; güzel olmuş. Bu şekilde işimizi görebiliriz. Elinize sağlık. Hayırlı geceler dilerim.

 

[turist]

Merhaba,
Sayın Turist, dosyayı inceledim; güzel olmuş. Bu şekilde işimizi görebiliriz. Elinize sağlık. Hayırlı geceler dilerim.

Sağ olun.
Sayın Ömer BARAN 'a ilk dosyanızı hazırladığı ve geliştirilmesinde yardımı olduğu için de teşekkür etmek gerekir.
Sağ olsun, var olsun.

 

[Fath]

Hocam şimdi farkettiğim bir sorunu yazmak istiyorum, eğer herhangi bir firmaya iki kişi değil de bir kişi tek yazarsak bu durumda çekilişi 1 kişi eksik yapıyor. Farzedelim kişi verileri sayfasında 33 kişi olsun ve biz de 33 kişiyi dağıtmak isteyelim; bazen hepsini dağıtıyor bazen de 32 kişi dağıtıp herhangi bir yeri boş bırakıyor.
Ekleme: Ayrıca çekiliş sayfasında bütün biçimlendirmeleri temizliyor; satır yükseklikleri, sütun genişlikleri bozuluyor; varsa eklenmiş şekil veya yazı kutusu onlar da nasibini alıyor. Bunu da düzeltmemiz mümkün müdür?

 

[Fath]

Çok incesiniz Hocam Üzerime borç olan teşekkürlerimi kendisine iletmiştim ben. Elleri dert görmesin.

 

[turist]

Hocam şimdi farkettiğim bir sorunu yazmak istiyorum, eğer herhangi bir firmaya iki kişi değil de bir kişi tek yazarsak bu durumda çekilişi 1 kişi eksik yapıyor. Farzedelim kişi verileri sayfasında 33 kişi olsun ve biz de 33 kişiyi dağıtmak isteyelim; bazen hepsini dağıtıyor bazen de 32 kişi dağıtıp herhangi bir yeri boş bırakıyor.
Ekleme: Ayrıca çekiliş sayfasında bütün biçimlendirmeleri temizliyor; satır yükseklikleri, sütun genişlikleri bozuluyor; varsa eklenmiş şekil veya yazı kutusu onlar da nasibini alıyor. Bunu da düzeltmemiz mümkün müdür?

1-) Kişi verileri ile Çekiliş Tablosundaki sayıların ve özellikle "Tür" bilgilerinin UYUMLU olması gerekir.
2-) "Çekiliş Tablosu" sayfası "CT" isimli sayfayı aynen kopyalayıp işleme hazırlıyor.
Bu sebeple; bütün biçimlendirmeleri "CT" sayfasında yaparak deneyin.
İyi çalışmalar.

 

[Fath]

Sayılar ve sınıflar doğru ama tek haneli işlemlerde sıkıntı çıkıyor hocam.

 

[turist]

Bu konuda tartışma yaratarak meseleyi uzatmak istemem.
Fakat; eklediğiniz dosyadaki örneğe göre bakılıdığında:
Kişi verileri : 30 Kişi (3 kişinin hangi satıra gideceği belirlenmiş durumda)
Çekiliş Tablosu: Tür sütununda 29 adet değer yazılmış.(Başkan Eğitim Kurumuna sadece 1 kişi belirlenmiş)
30 kişiyi bu tabloya nasıl dağıtmak gerekir?
(30 - 29)= 1 kişinin akıbeti ne olacaktır?

Mantıklı bir açıklama yaparsanız, sorunuza cevap verecek çıkabilir.

İyi çalışmalar.