Zufallszahlen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zufallszahlen

18.11.2005 23:15:20

th.heinrich

AW: Zufallszahlen

18.11.2005 23:18:17

Josef Ehrensberger

AW: Zufallszahlen

18.11.2005 23:27:15

Dieter

AW: Zufallszahlen

18.11.2005 23:37:34

Josef Ehrensberger

aehmm, was ist......

18.11.2005 23:58:37

th.heinrich

AW: aehmm, was ist......

19.11.2005 00:10:07

Dieter

AW: aehmm, was ist......

19.11.2005 00:17:06

MichaV

danke Dieter & Micha.....

19.11.2005 01:20:33

th.heinrich

AW: Zufallszahlen

20.11.2005 00:07:31

nighty

Hallo Dieter!
Eine Möglichkeit!
Sub ZufallsZahlen()
Dim dblZahlen() As Long, dblGezogen() As Variant
Dim intCount As Integer, intIndex As Integer, intZufall As Integer
Dim intStart As Integer, intEnde As Integer, intAnzahl As Integer

intStart = 1 'Erste Zahl
intEnde = 256 'Letzte Zahl
intAnzahl = 128 'Anzahl Zufallszahlen

Redim dblZahlen(intEnde - intStart)
Redim dblGezogen(intAnzahl - 1)

'Array füllen
For intCount = intStart To intEnde
  dblZahlen(intIndex) = intCount
  intIndex = intIndex + 1
Next

intIndex = 0
Randomize Timer

'Zufallszahlen ziehen
For intCount = 0 To intAnzahl - 1
  intZufall = Int(Rnd() * UBound(dblZahlen))
  dblGezogen(intIndex) = dblZahlen(intZufall)
  dblZahlen(intZufall) = dblZahlen(UBound(dblZahlen))
  If UBound(dblZahlen) = 0 Then Exit For
  Redim Preserve dblZahlen(UBound(dblZahlen) - 1)
  intIndex = intIndex + 1
Next

'Zufallszahlen sortieren
QuickSort dblGezogen

'In Bereich ausgeben (ab "A1")
Range(Cells(1, 1), Cells(intAnzahl, 1)) = Application.Transpose(dblGezogen)

End Sub

' Quicksort
'
Sub QuickSort(data() As Variant, Optional UG, Optional OG)
Dim P1&, P2&, T1 As Variant, T2 As Variant

UG = IIf(IsMissing(UG), LBound(data), UG)
OG = IIf(IsMissing(OG), UBound(data), OG)

P1 = UG
P2 = OG
T1 = data((P1 + P2) / 2)

Do

  Do While (data(P1) < T1)
    P1 = P1 + 1
  Loop

  Do While (data(P2) > T1)
    P2 = P2 - 1
  Loop

  If P1 <= P2 Then
    T2 = data(P1)
    data(P1) = data(P2)
    data(P2) = T2
    P1 = P1 + 1
    P2 = P2 - 1
  End If

Loop Until (P1 > P2)

If UG < P2 Then QuickSort data, UG, P2
If P1 < OG Then QuickSort data, P1, OG

End Sub

'******************************
'* Gruß Sepp
'*
'* Rückmeldung wäre nett!
'******************************

Sub makro01() Randomize Timer ReDim zuzahl(256) As Integer Dim zahl(128) As Integer Dim endeindex As Integer Dim allezahlen As Integer Dim ziehung As Integer Dim gezogen As Integer endeindex = 128 For allezahlen = 1 To 256 zuzahl(allezahlen) = allezahlen Next allezahlen For ziehung = 1 To 128 gezogen = Int(Rnd * endeindex) + 1 zahl(ziehung) = zuzahl(gezogen) zuzahl(gezogen) = zuzahl(endeindex) endeindex = endeindex - 1 ReDim Preserve zuzahl(endeindex) Cells(ziehung, 1) = zahl(ziehung) Next ziehung End Sub

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread