Koşullu rastgele

[serkanbayar]

Merhaba;

Forum içi yaptığım rastgele aramalarında rastlamadığım bir rastgele sorusu ile karşınızdayım , yapmak istediğim şeyi excel dosyasında detayları ile anlattım ancak hemen kısa özetini buraya yazayım.

1'den 6 ya kadar olan numaraları rastgele alt alta yazmak istiyorum ancak
hangi numaradan kaç kere yazılacağı hep bir değişken.

Örnek;

15 adet 1
10 adet 2
7 adet 3
5 adet 4
15 adet 5
20 adet 6

bir sonraki seferde 15 adet 1 değilde 20 adet 1 olacak 10 adet 2 yerine 5 adet 2 olacak..

 

[serkanbayar]

Hocalarım yardımlarınıza çok ihtiyacım var. kendi yöntemim ile işlem çok uzun sürüyor.

Biraz daha basitleştirecek olursak,

Benim belirttiğim kadar rakamı alt alta rastgele yazsın.

Örnek,

2 adet 1
4 adet 2
1 adet 3

Makroyu çalıştırınca şöyle olsun.

2
1
3
1
2
2
2

 

[Muhammet Okumuş]

Merhaba,

http://www.excel.web.tr/f14/belirli-sayyda-rastgele-isim-atama-t125003.html

linkini inceleyiniz.

 

[serkanbayar]

Muhammet Bey desteğiniz için çok teşekkür ederim. Verdiğiniz linkteki örneği inceledim. personel yerine 1,2,3,4,5,6 yazdım ve kişi yerine istediğim sayıları yazdım. B sütununa rastgele alt alta sayıları atıyor. peki şöyle bir şey yapabilir miyiz?

Örnek;

A sütununa hangi sayıları istediğimi yazacağım B sütununa kaçar adet istediğimi yazacağım.
2. satırdan başlamak üzere D,F,H,J,L,N,P,R,T ve V sütunlarına (1 er atlayarak toplam 10 tane) rastgele alt alta dağıtmasını bir makro ile yazabilir miyiz? çok teşekkür ederim

 

[Muhammet Okumuş]

Merhaba,

Sub Dağıt()
Application.ScreenUpdating = False
Range("D2:V1000") = ""
x = Range("A100").End(3).Row
For i = 2 To x
Top = WorksheetFunction.Sum(Range("B2:B" & i)) + 1
son = Range("D1000").End(3).Row + 1
Range("D" & son & "" & Top) = Cells(i, 1).Value
Next i

son = Range("D1000").End(3).Row
Range("C2:C" & son) = "=RAND()"

For i = 6 To 22 Step 2
Range("C2" & son).Sort Range("C2"), xlAscending

Range(Cells(2, i), Cells(son, i)) = Range("D2" & son).Value
Next i
Range("C:C") = ""
End Sub

Dosyayı inceleyiniz.

 

[serkanbayar]

Muhammet bey istediğim tam olarak buydu, ancak hala çözemediğim bir sıkıntım var oda aradaki boşluklara bir formül yazıyorum ancak dağıta tıkladığım zaman yazdığım formül ortadan kalkıyor ve tekrar formül yazılmamış hale dönüyor. Dağıta bastığım zaman sütun aralarındaki formülün gitmemesini nasıl sağlarım? iyi akşamlar

 

[Muhammet Okumuş]

Sub Dağıt()
Application.ScreenUpdating = False
Range("D21000,F2:F1000,H2:H1000,J2:J1000") = ""
Range("L2:L1000,N2:N1000,P21000") = ""
Range("R2:R1000,T2:T1000,V2:V1000") = ""
x = Range("A100").End(3).Row
For i = 2 To x
Top = WorksheetFunction.Sum(Range("B2:B" & i)) + 1
son = Range("D1000").End(3).Row + 1
Range("D" & son & "" & Top) = Cells(i, 1).Value
Next i

son = Range("D1000").End(3).Row
Range("C2:C" & son) = "=RAND()"

For i = 6 To 22 Step 2
Range("C2" & son).Sort Range("C2"), xlAscending

Range(Cells(2, i), Cells(son, i)) = Range("D2" & son).Value
Next i
Range("C:C") = ""
End Sub

C sütununa bir şey yazmayın. Orası yardımcı sütun. Eğer orada formül varsa tekrar düzenleme yapmamız gerekir.

 

[serkanbayar]

Muhammet Bey ne kadar teşekkür etsem azdır. Yardımınız sayesinde birkaç gün süren işlemleri birkaç saat içerisinde yapabileceğim. tekrardan teşekkürler

 

[Muhammet Okumuş]

Rica ederim.
İyi çalışmalar.

 

[Muhammet Okumuş]

Merhaba D ve V sütunlarının aynı olmaması için,

Sub Dağıt()
Application.ScreenUpdating = False
Range("D21000,F2:F1000,H2:H1000,J2:J1000") = ""
Range("L2:L1000,N2:N1000,P21000") = ""
Range("R2:R1000,T2:T1000,V2:V1000") = ""
x = Range("A100").End(3).Row
For i = 2 To x
Top = WorksheetFunction.Sum(Range("B2:B" & i)) + 1
son = Range("D1000").End(3).Row + 1
Range("D" & son & "" & Top) = Cells(i, 1).Value
Next i

son = Range("D1000").End(3).Row
Range("C2:C" & son) = "=RAND()"

For i = 6 To 22 Step 2
Range("C2" & son).Sort Range("C2"), xlAscending

Range(Cells(2, i), Cells(son, i)) = Range("D2" & son).Value
Next i
Range("C2" & son).Sort Range("C2"), xlAscending
Range("C:C") = ""
End Sub

kodunu kullanınız.

 

[oktobır]

Merhabalar,
Benim çözmek istediğim problem şöyle:
A1'den Ax'e kadar yazılmış x tane sayı var. Bu x tane sayının sıralamasını rastgele değiştirmek istiyorum. Bu değiştirme işlemini de y defa tekrarlamak istiyorum ve y tane farklı sıralamayı da farklı sütunlarda liste şeklinde görmek istiyorum.
Ör:
A1'den A40'a kadar 40 sayım var. Bu 40 sayıyı 20 defa rastgele karıştırmak ve her karıştırma işleminin sonuçlarını da sırasıyla B, C, D, E, F, G, H.................., U sütunlarında görmek istiyorum. Bu konuda bana yardımcı olabilirseniz sevinirim. Şimdiden teşekkürler.

 

[oktobır]

Muhammet Bey Merhabalar,
Benim çözmek istediğim problem şöyle:
A1'den Ax'e kadar yazılmış x tane sayı var. Bu x tane sayının sıralamasını rastgele değiştirmek istiyorum. Bu değiştirme işlemini de y defa tekrarlamak istiyorum ve y tane farklı sıralamayı da farklı sütunlarda liste şeklinde görmek istiyorum.
Ör:
A1'den A40'a kadar 40 sayım var. Bu 40 sayıyı 20 defa rastgele karıştırmak ve her karıştırma işleminin sonuçlarını da sırasıyla B, C, D, E, F, G, H.................., U sütunlarında görmek istiyorum. Bu konuda bana yardımcı olabilirseniz sevinirim. Şimdiden teşekkürler.

 

[Muhammet Okumuş]

Merhaba,

Sub Dağıt()
Application.ScreenUpdating = False
Columns(2).Insert
son = Cells(Rows.Count, "A").End(3).Row
Range("B1:B" & son) = "=Rand()"
Range("C1:C" & son) = Range("A1:A" & son).Value
For i = 4 To 22
Range("B1:C" & son).Sort Range("B1")
Range("C1:C" & son).Copy Cells(1, i)
Next
Columns(2).Delete
End Sub

kodunu deneyiniz.

 

[oktobır]

Yardımınız için çok teşekkürler...Tam İstediğim gibi olmuş

 

[Muhammet Okumuş]

Rica ederim. İyi çalışmalar.