Rastgele Sayı Üretme!

[abdullahozdem27]

Arkadaşlar Merhaba,

Elimde 40,60,80,100,120 kişilik gruplar var her grupta birbirinden bağımsız sayılarda kişiler var.(Örn: 40 kişilik grup 5 kişi) Ayrıca birbirinden bağımsız 2 - 3 veya da fazla 40 kişilik gruplar var onlarında içerisinde bulunan kişi sayıları farklı yapmak istediğim şey her bir grup için birbirinden bağımsız olarak kişi sayısı kadar benzersiz değer üretmek.(Örn: 40 kişilik grup 1 de bulunan 5 kişi için 1 den 40 a kadar 5 adet benzersiz değer üretip yanına yazmak)makroda bir formül yazmaya çalıştım.Tek grup için yapabildim ama grup sayısı arttıkça iş karıştı.Yardımlarınızı edebilirseniz çok sevinirim.

Şimdiden çok teşekkür ederim.

 

[abdullahozdem27]

Arkadaşlar yardımlarınızı bekliyorum.

Teşekkür ederim.

 

[abdullahozdem27]

Arkadaşlar Konu Güncel hala sorunu çözemedim.

 

[ÖmerBey]

Merhaba,
Çekiliş yapmak istediğiniz sayfada aşağıdaki kodu çalıştırınız.

Sub kod()
Set syf = ActiveSheet
If IsNumeric(syf.Name) Then
uret:
    mk = CByte(syf.Name)
    ReDim sylr(1 To mk)
    For a = 1 To mk
        sylr(a) = a
    Next
    
    For i = 2 To syf.Range("B65500").End(3).Row
        If syf.Cells(i, "B") <> syf.Cells(i - 1, "B") Then
            x = 0
            GoTo karistir
        End If
yaz:
        x = x + 1
        syf.Cells(i, "A") = sylr(x)
    Next
End If
Exit Sub

karistir:
For a = LBound(sylr) To UBound(sylr)
    y = Int(Rnd * UBound(sylr) + 1)
    gec = sylr(a)
    sylr(a) = sylr(y)
    sylr(y) = gec
Next
GoTo yaz
End Sub

 

[abdullahozdem27]

Hocam Merhabalar,

Kodu denedim ancak ilk satırında compile error: Expected:list separator or) şeklinde hata alıyorum.

Yardımınız için çok teşekkür ederim

 

[ÖmerBey]

Kopyalarken parantezlerden birini eksik koymuş olmalısınız.

 

[abdullahozdem27]

Hocam Merhabalar,

Elinize emeğinize sağlık ancak bir problem daha var grup numarasını sıralı yaptığımda formül çalışıyor.Ancak araya farklı grup numaraları girdiğinde rakamlar birbirine benzer geliyor benzersizliği ortadan kalkıyor.Ayrıca bu formülü sayfa ismine değilde bir textbox'a nasıl bağlayabilirm çekiliş bittiğinde çekiliş bitti uyarısını nasıl yaptırabilirim.

Yardımlarınız için çok teşekkür ederim.Allah razı olsun.

 

[ÖmerBey]

Tekrar merhaba,
İstekleriniz doğrultusunda kodun düzenlenmiş hali aşağıdadır, iyi çalışmalar...

Sub kod()
Set syf = ActiveSheet
son = syf.Range("B65500").End(3).Row
bas:
syf.Range("A2:C" & son).Sort syf.Range("B2") 'Sıralama satırı
syf.Range("A2:A" & son).ClearContents
mk = Application.InputBox("Çekiliş sayısını girin.", Type:=1)
If mk = False Then Exit Sub
ReDim sylr(1 To mk)
For a = 1 To mk
    sylr(a) = a
Next

For i = 2 To son
    If syf.Cells(i, "B") <> syf.Cells(i - 1, "B") Then
        x = 0
        GoTo karistir
    End If
yaz:
    If x < mk Then
        x = x + 1
        syf.Cells(i, "A") = sylr(x)
    Else
        MsgBox "Çekiliş sayısı kişi sayısından az." & vbLf & _
             "Uygun bir sayı girerek tekerar deneyiniz.", vbCritical
        GoTo bas
    End If
Next
MsgBox "Çekiliş bitti"
Exit Sub

karistir:
For a = LBound(sylr) To UBound(sylr)
    y = Int(Rnd * UBound(sylr) + 1)
    gec = sylr(a)
    sylr(a) = sylr(y)
    sylr(y) = gec
Next
GoTo yaz
End Sub