1--52 arası sayıları Karıştırmak...

[ECYavuz]

Pazarınız aydın olsun diyeceğim ama İstabul'da hava oldukça kapalı...

Dim Sayı(1 to 52)

1 den 52 ye kadar sayıları Randomize ve Rnd kullanarak; her bir sayıyı bir kere kullanmak üzere en hızlı şekilde karışık nasıl sıralıyabiliriz?

Tabii Bu sayıları X=1 to X=52 kadar Sayı(X) değişkenine atayacağız...

Saygılarımla...

 

[veyselemre]

Sub deneme()
Dim sayi(1 To 52) As Integer
    For x = 1 To 52
        sayi(x) = x
    Next x
    randomize timer
    For x = 1 To 52
bas:
        say = Int(Rnd(x) * 52)
        If say > 52 Or say < 1 Then GoTo bas
        ara = sayi(x)
        sayi(x) = sayi(say)
        sayi(say) = ara
    Next x
    For x = 1 To 52
        Cells(x, 1) = sayi(x)
    Next x
End Sub

 

[ECYavuz]

Çok Sağolun Sayın Veysel;

Forumda bulduğum aşağıdaki kod da hızlı çalışıyor ama 0 dan başlıyor halbuki ben 1 den başlamasını istiyorum..

Sub Düğme3_Tıklat()

Dim arr() As Long

ReDim arr(52 - 1)
say = 0 'Bundan kaynaklanıyor olabilirmi?
For i = Min To Max
arr(say) = i
say = say + 1
Next

For j = 0 To UBound(arr)
x = Int(((Max - Min) * Rnd))
temp = arr(x)
arr(x) = arr(j)
arr(j) = temp
Next j
For i = 0 To UBound(arr)
Cells(i + 1, 1) = arr(i)
Cells(i + 1, 2) = i
Next

End Sub

 

[ECYavuz]

Tekrar teşekkürler çok da hızlı çalışıyor...

 

[ECYavuz]

Sayıları Karıştır, 4 e ayır ve sırala

Gününüz aydın olsun;

1 den 60 a kadar olan sayıları karıştırdık. Kod aşağıda ama bunları (karışık sıralanmış sayıları) 15 lik guruplar halinde kendi aralarında küçükten büyüğe doğru sıraya koyamayı beceremedim... Yardımlarınıza ihtiyacım var... Örnek dosya aşağıda.. Şimdiden çook teşekkürler...

Saygılarımla.

Dim CB(60) As Integer

Sub Autpen()
'------------------------------------
' 1 den 60 kadar olan rakamları karıştırmak
Randomize Timer
For I = 1 To 60
CB(I) = I
Next I
For I = 1 To 60
J = Int(Rnd * 60) + 1
CB(0) = CB(I)
CB(I) = CB(J)
CB(J) = CB(0)
Next I
For I = 1 To 60
Cells(I, 2) = CB(I)
Next I

'Karıştırılan Sayılardan ilk 15 ini kendi arasında küçükten büyüğe sıralamak
For I = 1 To 15
Cells(I + 1, 1) = Cells(I, 2)
Next I

'Sonrada diğer 15 lik gurupları kendi arasında küçükten büyüğe sıralamak
For I = 16 To 30
Cells(I + 1, 1) = Cells(I, 2)
Next I

For I = 31 To 45
Cells(I + 1, 1) = Cells(I, 2)
Next I

For I = 46 To 60
Cells(I + 1, 1) = Cells(I, 2)
Next I

' Takıldığım yer bu ara
' Yardımlarınız için teşekkürler

End Sub

 

[veyselemre]

Dim CB(60) As Integer
Sub Auto_Open()
'------------------------------------
' 1 den 60 kadar olan rakamları karıştırmak
    Randomize Timer
    For I = 1 To 60
        CB(I) = I
    Next I
    For I = 1 To 60
        J = Int(Rnd * 60) + 1
        CB(0) = CB(I)
        CB(I) = CB(J)
        CB(J) = CB(0)
    Next I
    For I = 1 To 60
        Cells(I, 2) = CB(I)
    Next I
    bas = 1: son = 15: GoSub siralaYaz
    bas = 16: son = 30: GoSub siralaYaz
    bas = 31: son = 45: GoSub siralaYaz
    bas = 46: son = 60: GoSub siralaYaz
    Exit Sub
siralaYaz:
    For x = bas To son - 1
        For y = x + 1 To son
            If CB(x) > CB(y) Then
                CB(0) = CB(x)
                CB(x) = CB(y)
                CB(y) = CB(0)
            End If
        Next y
    Next x
    For x = bas To son
        Cells(x, 1) = CB(x)
    Next x
    Return
End Sub

 

[metinozlu]

mokro kaydet yöntemi ile koda yaptığım ek ile çözüm ektedir.

 

[uzmanamele]

merhaba
yapmaya çalıştığınız olsa olsa briç programıdır. bittiğinde görmek isterim

 

[ECYavuz]

Sayın VeyselEmre Üstadım ve Sayın metinozlu her ikinize de sonsuz teşekkürler.

Metin beyin çözümü oldukça ilginç ama uzun bir kod... Veysel hoczmınki ise son derece pratik... bilginize ve emeğinize sağlık...

 

[ECYavuz]

Helal Olsun...

merhaba
yapmaya çalıştığınız olsa olsa briç programıdır. bittiğinde görmek isterim

Hocam senden de hiç bir kaçmıyor. Helal olsun valla... Hep birlikte yapacağız inşallah... Ben image kısmını halettim de gerisi Forum dostlarıyla...