For Next Schleife durcheinander

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub randomLoop() Dim check(7) As Boolean 'alle Indikatoren auf false setzen For i = 1 To 7 check(i) = False Next i = 1 Do Until check(1) = True And check(2) = True And check(3) = True And check(4) = True _ And check(5) = True And check(6) = True And check(7) = True i = Int((7 * Rnd) + 1) 'verhindern, dass am Index i nachfolgende Rechenoperationen doppelt durchgefuehrt werden If Not check(i) = True Then check(i) = True 'weitere Operationen End If 'gesamte loops zaehlen loop1 = loop1 + 1 Loop MsgBox loop1 End Sub

Sub testRandomLoop2() Dim check(7) For i = 1 To 7 check(i) = False Next i = 1 Do Until j = 7 i = Int((7 * Rnd) + 1) If check(i) = False Then check(i) = True 'weitere Operationen j = j + 1 End If loop1 = loop1 + 1 Loop MsgBox j & ", " & loop1 End Sub

Hallo Heiko,
man kann alternativ auch direkt ein Objekt ohne doppelte Einträge erstellen. Dabei erfordert in der 2. Variante das Scripting.Dictionary-Objekt einen besonders kurzen Code.
Zusätzlich solltest du die Randomize-Zeile übernehmen. Dein Code liefert sonst nach jedem Öffnen der Datei die gleiche Serie von Zufallszahlen.
Gruß
Franz

Sub testRandomLoop2()
Dim objCollection As New Collection, i As Integer, j As Integer
Dim loop1 As Long, strMsg As String
Randomize
Const AnzZahlen As Integer = 7
On Error GoTo Fehler
Do Until j = AnzZahlen
i = Int((AnzZahlen * Rnd) + 1)
objCollection.Add Item:=i, Key:=CStr(i)
'weitere Operationen
j = j + 1
Resume_Loop:
loop1 = loop1 + 1
Loop
'Testanzeige
strMsg = ""
i = 1
strMsg = strMsg & objCollection(i)
For i = 2 To objCollection.Count
strMsg = strMsg & " - " & objCollection(i)
Next
MsgBox j & ", " & loop1 & vbLf & strMsg
Fehler:
With Err
Select Case .Number
Case 0 'alles OK
Case 457 'Fehler tritt auf, wenn doppelter Schlüssel in Collection eingetragen werden  _
soll
Resume Resume_Loop
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
'Variablen aufräumen
Set objCollection = Nothing
End Sub
Sub testRandomLoop3()
Dim objDic As Object, arrWerte
Dim i As Integer
Dim loop1 As Long, strMsg As String
Randomize
Const AnzZahlen As Integer = 7
Set objDic = CreateObject("Scripting.Dictionary")
Do Until objDic.Count = AnzZahlen
i = Int((AnzZahlen * Rnd) + 1)
objDic(i) = 0 'Nur Unikate sammeln
'weitere Operationen
loop1 = loop1 + 1
Loop
'Testanzeige
arrWerte = objDic.keys
strMsg = ""
i = LBound(arrWerte)
strMsg = strMsg & arrWerte(i)
For i = i + 1 To UBound(arrWerte)
strMsg = strMsg & " - " & arrWerte(i)
Next
MsgBox objDic.Count & ", " & loop1 & vbLf & strMsg
'Variablen aufräumen
Set objDic = Nothing: Erase arrWerte
End Sub

Hallo
ICh nutze sowas um z.B. schnell zufällig verteilete Beispieldaten in eine Tabelle zu bekommen.
Schau es dir mal an:

Option Explicit

Public Sub array_Füllen()
    Dim L As Long
    Dim n As Long
    n = 10
    Redim arr(1 To n) As Variant
    For L = 1 To n
        arr(L) = L
    Next
    MsgBox Join(arr, vbCrLf)

    arr = array_mischen(arr)
    MsgBox Join(arr, vbCrLf)
End Sub

Public Function array_mischen(vntarr As Variant)
    Dim I As Long
    Dim tmp As Variant
    Dim Z As Long
    Randomize Timer
    '#########
    For I = LBound(vntarr) To UBound(vntarr)
        Z = Int((UBound(vntarr) * Rnd) + LBound(vntarr))
        tmp = vntarr(Z)
        vntarr(Z) = vntarr(I)
        vntarr(I) = tmp
    Next
    array_mischen = vntarr
End Function

ransi

Sub Zufalls_Step() Dim ArrBereich, n& Dim nZufall& 'Zufallszahlen von bis Const lngVon& = 1 Const lngBis& = 5 ArrBereich = Range("A1:A100") For n = 1 To UBound(ArrBereich) nZufall = Int((lngBis - lngVon + 1) * Rnd + lngVon) n = n + nZufall - 1 If n > UBound(ArrBereich) Then Exit For Debug.Print ArrBereich(n, 1) Next n End Sub

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

For Next Schleife durcheinander

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

305 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread