Farklı Sütunlardaki Sayıları Belirli Kriterlere Göre Rastgele Atamak

[alparslanozmol]

MErhaba,

Benim aşağıdaki şekilde bir sorunum var ve çözemedim.Değerli desteklerinizi rica ederim.

A sütununda 1-27 ye kadar sayılar mevcut (sayılar birbirinden farklı yani sıralı)
B sütununda 1-6 ya kadar sayılar mevcut (sayılar birbirinden farklı yani sıralı)
C sütununda 1-12 ye kadar sayılar mevcut (sayılar birbirinden farklı yani sıralı)

Yapmak istediğim ;

D1 hücresine A sütunundan rastgele bir sayı
F1 hücresine A sütunundan rastgele bir sayı
G1 hücresine B sütunundan rastgele bir sayı
H1 hücresine C sütunundan rastgele bir sayı
I1 hücresine C sütunundan rastgele bir sayı

Kritik nokta çıkan sayı bir daha çıkmayacak (yani sütunda bir kere seçilen sayı artık seçilemeyecek) ve bu döngü B sütunundaki tüm sayılar bitene kadar alt alta 6 satır (D2,F2,G2,H2,I2 / D3,F3,G3,H3,I3 /D4,F4,G4,H4,I4 ....) devam edecek.

Şimdiden destekleriniz için teşekkür ederim.

Saygılarımla,

 

[PLİNT]

Merhaba
Aşağıdaki gibi olabilir.

[SIZE="2"]Private Sub CommandButton1_Click()
Dim f, f2 As Variant
Dim a As Long
Dim m As Single
Dim s As Range
f = Array(27, 6, 12)
f2 = Array("D1:D6,F1:F6", "G1:G6", "H1:I6")
Range("D1:D6,F1:F6, G1:G6, H1:I6") = Empty
For a = 0 To UBound(f)
For Each s In Range(f2(a))
geri:
If WorksheetFunction.CountA(Range("D1:D6,F1:F6, G1:G6, H1:I6")) = 30 Then Exit Sub
m = Int((f(a) * Rnd) + 1)
If Not Range(f2(a)).Find(Cells(m, a + 1), , , xlWhole) Is Nothing Then GoTo geri
s.Value = Cells(m, a + 1)
Next:
Next
End Sub [/SIZE]