*

Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Pagina's: [1]   Omlaag

Auteur Topic: unieke randomnummers trekken  (gelezen 2383 keer)

0 leden en 1 gast bekijken dit topic.

Offline Diezel

  • Oplosser
  • ****
  • Berichten: 508
  • Geslacht: Man
  • Meedenker - Initiatief nemen - Helpen oplossen...
unieke randomnummers trekken
« Gepost op: 30 december 2011, 03:13:50 »
Ik wens unieke getallen genereren. In onderstaande code moet er nog wat tussenkomen om dubbele getallen te voorkomen.

Code: [Selecteer]

Private Sub cmdSorteren_Click()

Const aantal = 6 'Aantal te sorteren getallen
Dim getallen(aantal) As Integer 'Array met getallen

Dim i As Integer 'hulpvariabele
Dim Gesorteerd As Boolean 'gesorteerd? ja of nee
Dim dummy As Integer 'hulpvariabele
Dim cyclus As Integer 'hulpvariabele testrondes

Randomize
Gesorteerd = False 'Begin met gesorteerd op onwaar te zetten

'Hier begint de cyclus tot als Gesorteerd waar is

cyclus = 0

'genereer de random getallen
For i = 0 To aantal - 1
getallen(i) = Int(44 * Rnd) + 1 'random getal 1 tot 9

Next

cmdSorteren.Visible = True ' zet de knop sorteren aan

Do While Not (Gesorteerd)
Gesorteerd = True ' Eerst aan zetten

For i = 0 To aantal - 2 'Het voorlaatste heeft als index Aantal -2


If getallen(i) > getallen(i + 1) Then 'Vergelijk…

dummy = getallen(i) 'Omwisselen
getallen(i) = getallen(i + 1)
getallen(i + 1) = dummy

Gesorteerd = False 'nog niet goed
End If

Next i

' eentje bijtellen na één cyclus
cyclus = cyclus + 1

Loop 'herbegin de cyclus

Dim uitslag As String
For i = 0 To aantal - 1
uitslag = uitslag & getallen(i) & " - "
Next i

'MsgBox uitslag, 64 + 0, "random getallen"


End Sub


Wie kent de oplossing?

Diezel
Gelogd
OS: Windows 10 Home - 64 bit
Processor:  Intel(R) Core(TM) I7 - 4770 CPU 3,40 GHZ
SSD - RAM: 500 GB, 16 GB
SOFTWAREPAKKET: Office 2007

Offline dizzl

  • Ambassadeur
  • *****
  • Berichten: 2.345
  • I've Upped my standards,now,up yours!
Re: unieke randomnummers trekken
« Reactie #1 Gepost op: 02 januari 2012, 07:49:03 »
Code: [Selecteer]
Private Sub cmdStart_Click()
    'We maken een array met 45 elementen en zetten deze allemaal op true
    Dim LottoCijfers(1 To 45) As Boolean
    For i = 1 To 45
        LottoCijfers(i) = True
    Next i
   
    '***************************************************************************
    'Nu nemen we er 6 elementen uit en stoppen die in een array WinnendeCijfers
    '***************************************************************************
    Randomize
    Dim HuidigCijfer As Byte
   
    Dim WinnendeCijfers(1 To 6) As Byte
   
   
    For i = 1 To 6
        'Kies een willekeurig getal
        HuidigCijfer = Rnd() * 45 + 1
        'Zolang dat getal niet gekozen is neem een ander
        While LottoCijfers(HuidigCijfer) = False
            'kies een nieuw getal
            HuidigCijfer = Rnd() * 45 + 1
        Wend
        'Stop het gekozen getal in het winnende cijfer
        WinnendeCijfers(i) = HuidigCijfer
        'en zet Lottocijfer(Huidigcijfer) op false
        LottoCijfers(HuidigCijfer) = False
        'Voeg toe aan de listbox
        lstWinnendeGetallen.AddItem (HuidigCijfer)
    Next i
End SubZo zou ik 6 willekeurige getallen kiezen.
Gelogd
Systeem  : Intel Core i5-4440 3.1Ghz, 3.1GHz 16Giga Ram 64Bits
Software : Windows 10 professional, Avira, Office 2016 Professional

Offline Diezel

  • Oplosser
  • ****
  • Berichten: 508
  • Geslacht: Man
  • Meedenker - Initiatief nemen - Helpen oplossen...
Re: unieke randomnummers trekken
« Reactie #2 Gepost op: 02 januari 2012, 16:58:26 »
Dizzl,

op deze manier heb ik het nog niet bekeken.
Alvast bedankt voor de ondersteuning.
Ik heb de smaak terug te pakken.
Het was even geleden, bovenop mijn bestandjes verloren geraakt door panne.

Diezel
Gelogd
OS: Windows 10 Home - 64 bit
Processor:  Intel(R) Core(TM) I7 - 4770 CPU 3,40 GHZ
SSD - RAM: 500 GB, 16 GB
SOFTWAREPAKKET: Office 2007
Pagina's: [1]   Omhoog
 


www.combell.com