Rastegele Seç Sutuna yaz

[Grimm80]

Merhabalar

A1 B1 C1 D1 E1 Sutunlarında sporcular var. Her sutun satırlara göre bazen 18 e kadar çıkıyor Örnek A sutununda 18 sporcu var B sutununda 15 Sporcu var C sutunuda 9 sporcu var D sutununda 25 sporcu var E sutunun da ise 50 Sporcu F sutununda 20 sporcuvar benim istediğim her sutundan 1 adet sporcu rasgele seçsin ve secmiş olduğu eşleştirmeleri H2, I2, J2,K2,L2,M2 sutununa yazsın sonra yeniden şeçtiğimde ise yine yeniden rasgele başkalarını secsin. Bir neyi sayısal loto sistemi gibi bun nasıl yaparım Örnek tablo ektedir. Şİmdiden tşk. ederim Örnek adresi burada resmim.net/f/4m41d6.jpg

Not: örnek resimde D sututnda D17 secili gözüküyor ama sutunda sadece yazılı olanları sececek yani boş olanları oraya yazmayacak

 

[Muhammet Okumuş]

Merhaba,
Yardımcı sütun kullanılmasında sıkıntı olur mu?

 

[Grimm80]

Merhabalar

Yardımcı sutun sorun olmaz Olmaz. Tam olarak a sutununa pazartesi günkü sporcular b sututuna salı günkü (c çarşamba gibi) sporcular olacak h1 k1 ile başlayan sutunlarda günler yine olacak a1 deki pazartesi günkü sporcular (örnek 18 tanesi var ise ) a1 hücresinden sporculardan H1 hücresine (pazartesiye) alt alta 4 tanesi rastgele eşleştirip atayacak (h2 ahmet h3 mehmet h4 ahmet h5veli gibi) 5 gün deki sporcular 5 günde rasgele atama

tşk.ler

 

[Muzaffer Ali]

Merhaba.
Dosyanız hazır.

https://www.dosyaupload.com/9yaR

 

[Grimm80]

Çok Tşk. ederim Elinize sağlık

 

[Muzaffer Ali]

Rica ederim iyi çalışmalar.

 

[Muhammet Okumuş]

Mükerrer olmasını istemiyorsanız, kodları kullanınız. AA:AI aralığı yardımcı sütun

Sub Dağıt()
Application.ScreenUpdating = False
If Range("AD1") <> "" Then GoTo 10
For i = 1 To 6
Range("AA2:AA1000") = Range(Cells(2, i), Cells(1000, i)).Value
son = Cells(Rows.Count, 27).End(3).Row
Range("AB2:AB" & son) = "=RAND()"
Range("AA2:AB" & son).Sort Range("AB2")

Range(Cells(2, i + 29), Cells(1000, i + 29)) = Range("AA2:AA1000").Value
Range("AA2:AB1000") = ""
Next
10
Range("AD1") = Range("AD1") + 1
son = Range("AD1") + 1
Range("H" & son & ":M" & son) = Range("AD" & son & ":AI" & son).Value
End Sub


Sub Temizle()
Range("AD1:AI1000,H2:M1000") = ""
End Sub