Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

For Next Schleife durcheinander | Herbers Excel-Forum


Betrifft: For Next Schleife durcheinander von: Heiko
Geschrieben am: 18.02.2012 00:50:17

Hallo,

wie koennte man folgendes Problem loesen:

Eine For Next Schleife durchlaufen lassen, aber nicht in der Reihenfolge 1,2,3,...,n,
sondern zufaellig, also z.B. 3,6,1,...,n,
allerdings natuerlich ohne Wiederholung der Zahlen, also ohne "Zuruecklegen"

Waere z.B. interessant fuer Modellierung, wenn mehrere Parameter (z.B. in einem Array) fuer eine Loesung noetig sind und die Reihenfolge der Berechnung der Parameter entscheidend fuer das Ergebnis ist...

For i = 1 to 5
' i = zufaellig zw 1 und 5
arr(i) = ...
next

Durchlauf halt eben "durcheinander"

Wuerde mich ueber Ideen freuen. Ich mach mich jedenfalls auch selbst dran.
Danke schonmal im voraus,
Heiko

  

Betrifft: unelegante Loesung... von: Heiko
Geschrieben am: 18.02.2012 02:52:28

Ich habe eine moegliche Loesung probiert, die allerdings sehr unelegant ist:

Option Base 1

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
einerseits ist die Abfrage check(1) And check(2)... etc sehr unschoen, vor allem, wenn i groesser wird,
andereseits wird die Schleife sehr viel haeufiger durchlaufen als 7, weil eben per Zufall auch Zahlen zwische 1 und 7 mehrmals auftreten koennen.

Kann man das kuerzer oder eleganter loesen, so dass die Schleife nur 7 mal durchlaufen wird?

Bin auf Ideen gespannt,

Heiko


  

Betrifft: elegantere Loesung... von: Heiko
Geschrieben am: 18.02.2012 04:34:43

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



  

Betrifft: elegantere Loesung... von: Heiko
Geschrieben am: 18.02.2012 04:35:52

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



  

Betrifft: Warum nicht so, ... von: Luc:-?
Geschrieben am: 18.02.2012 05:14:04

…Heiko …

Const txParamFolge As String = "{1,3,2,5,4}"
Dim arIdx, Idx As Variant, arr As …
arIdx = Evaluate(txParamFolge)
For Each Idx in arIdx
    arr(Idx) = …
Next Idx
Das hätte auch den Vorteil, dass txParamFolge leicht geändert wdn könnte.
Morrn+schöWE, Luc :-?


  

Betrifft: AW: Warum nicht so, ... von: Heiko
Geschrieben am: 18.02.2012 23:00:26

Hi, Luc,

wird damit nicht die Reihenfolge der Zahlen (zwar durcheinander) aber willkuerlich von vornherein festgelegt?


  

Betrifft: Ja, denn du hast doch was von einer ... von: Luc:-?
Geschrieben am: 20.02.2012 18:03:04

…bestimmten Reihenfolge geschrieben, Heiko,
was mich daran erinnert hat, dass es mitunter nötig ist, eine BlattKalk manuell in bestimmter Reihenfolge durchzuführen. So ähnl hast du dich ja auch ausgedrückt. Wenn das aber gar nicht gemeint war, und du benötigst eine zufällige Reihenfolge, frage ich mich, warum du das Andere überhpt erwähnst, denn das hat dann ja gar nichts mit deinem Problem zu tun. Mitunter ist zuviel (unnötige) Info auch von Übel, denn die wird bei einer konkreten Fragestellung nicht erwartet. :-|
Ahoi! Luc :-?


  

Betrifft: AW: elegantere Loesung... von: fcs
Geschrieben am: 18.02.2012 06:42:01

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



  

Betrifft: AW: For Next Schleife durcheinander von: ransi
Geschrieben am: 18.02.2012 09:38:24

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


  

Betrifft: vielleicht mit Zufallszahlen (Rnd-Funktion) von: Tino
Geschrieben am: 18.02.2012 11:06:56

Hallo,
ich habe es mal mit Zufallszahlen versucht.

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
Gruß Tino


  

Betrifft: Danke! von: Heiko
Geschrieben am: 18.02.2012 22:58:58

Vielen Dank fuer die tollen Tipps!

Heiko


Beiträge aus den Excel-Beispielen zum Thema "For Next Schleife durcheinander"