random sayi üretimi

[gencoglu27]

Merhanba arkadaşlar..
"A" sütununa sayısal lotodaki gibi 1 den 49 a kadar bir birinden farklı 6 adet 1000 satırlık sayı üretmek istiyorum..bunu nasıl gerçekleştirebiliriz ?
Benim denediğimde sayıların bazıları aynı satırda aynı çıkıyor..
A sutununa =rastgelearada(1;49) aynı şeyi B,C,D,E,F sütunlarına da yapıp aşağı doğru kopyalıyınca olmakta fakat rakamlar benzer olmakta..
yardımcı olur musunuz ?
Teşekkürler..

 

[Korhan Ayhan]

Merhaba,

Ekteki örnek dosyayı incelermisiniz.

Uygulanan kod;

Option Explicit
 
Sub LOTO()
    Dim Sayı As Byte, Satır As Long, Sütun As Byte, Zaman As Date
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Zaman = Time
    Satır = 1
    Sütun = 1
    Range("A:F").ClearContents
 
Başla:
    Randomize
    Sayı = Int(Rnd() * 49) + 1
    If WorksheetFunction.CountIf(Range("A" & Satır, "F" & Satır), Sayı) > 0 Then GoTo Başla
    If Sütun > 6 Then
        Sütun = 1
        Satır = Satır + 1
    End If
    If Satır > 30000 Then GoTo Son
    Cells(Satır, Sütun) = Sayı
    Range("A" & Satır & ":F" & Satır).Sort Key1:=Range("A" & Satır), Orientation:=xlLeftToRight
    Sütun = Sütun + 1
    GoTo Başla
 
Son:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
    "İşlem süresi ; " & Format(Time - Zaman, "hh:mm:ss"), vbInformation
End Sub

 

[gencoglu27]

Teşekkür ediyorum Korhan Bey...
Umarım lotodan ikramiye sizede çıkar.. bana da çıkarsa %10 u sizin..

 

[gencoglu27]

1000 satır için iyi çalıştı.. fakat Satır sayısını 1000 den 30.000 e çıkarınca "debug" ve overflow uyarısı verdi..Bunu çözebilir miyiz ? Ayrıca sayıları küçükten büyüğe doğru sıralamak süper olacak..
bunun için kodu yeniden modife etmek mümkün mü

Çok teşekkür ettim.

 

[Orion1]

1000 satır için iyi çalıştı.. fakat Satır sayısını 1000 den 30.000 e çıkarınca "debug" ve overflow uyarısı verdi..Bunu çözebilir miyiz ? Ayrıca sayıları küçükten büyüğe doğru sıralamak süper olacak..
bunun için kodu yeniden modife etmek mümkün mü

Çok teşekkür ettim.

Aşağıdaki yaptığım programı deneyiniz.
SAYISAL LOTO-ŞANS TOPU-10 NUMARA

 

[gencoglu27]

Değerli Orion1 arkadaşım..yaptığınız program güzel olmuş fakat Korhan Ayhan arkadaşın verdiği kodu madife edip verilen sayıların "sıralı" olamsı işimi görür..yardımcı olur musunuz ? Teşekkürler..

 

[gencoglu27]

rakamları sıralamak

Merhaba arkadaşlar
Ekteki dosyada sırasız olarak verilen loto rakamlarını sıralamak
için yardımcı olur musunuz ?


Teşekkürler.

 

[Orion1]

Alternatif:
Hız konusundada sanırım bir artış oldu.bende 3 saniyede iş bitiyor.
Sıralamada tamamdır.
Dosyanız ektedir.

Option Base 1
Sub loto_59()
Dim col As Collection, i As Long, list(), sayi As Byte
Dim s As Byte, rakam As Byte, j As Long, y As Byte
'coder:evrengizlen@hotmail.com
'date:01.10.2011
Randomize Timer
Application.ScreenUpdating = False
Range("A:F").ClearContents
ReDim list(1 To 30000, 1 To 6)
For i = 1 To 30000
    Set col = New Collection
    For x = 1 To 49
        col.Add x
    Next x
    For s = 1 To 6
        rakam = Int(Rnd() * col.Count) + 1
        sayi = col(rakam)
        list(i, s) = sayi
        col.Remove (rakam)
    Next s
    Set col = Nothing
Next i
For i = 1 To UBound(list)
    For j = 1 To 5
         For y = j + 1 To 6
            If list(i, j) > list(i, y) Then
                x = list(i, j)
                list(i, j) = list(i, y)
                list(i, y) = x
            End If
        Next y
    Next j
Next i
Range("A1").Resize(30000, 6) = list
Erase list
'For i = 1 To 30000
    'Range("A" & i & ":F" & i).Sort key1:=Range("A" & i), order1:=xlAscending, Orientation:=xlSortRows
'Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[gencoglu27]

Harikasın Orion...Teşekkür ederim..Buna benzer bir programı Javascript ile yapiyordum.. uzun zaman alıyordu...
Not: loto çıkarsa paraları kırışırız..

 

[Orion1]

Harikasın Orion...Teşekkür ederim..Buna benzer bir programı Javascript ile yapiyordum.. uzun zaman alıyordu...
Not: loto çıkarsa paraları kırışırız..

Rica ederim.
Bol şanslar dilerim.

 

[Korhan Ayhan]

Merhaba,

Bende mesajımdaki kodu isteğiniz doğrultusunda revize ettim. Evren bey dizi yöntemini kullanarak örnek vermiş. Doğal olarak klasik döngüden daha hızlı sonuç veriyor. Benim hazırladığım kod ise yaklaşık 35 saniyede işlemi tamamlıyor.

Bu iki alternatifi inceleyen üyelerimizi sıradan döngü ile dizi arasındaki farkı gayet iyi gözlemleyebilirler.