Gas Verhalten in VBA

Question

mein Projekt soll nicht-ideale Gasbewegung vorherzusagen, also schrieb ich diesen Code, um jedem Molekül eine bestimmte Zahl zu geben, aber es wiederholt Zahlen wiederholt (ich benutzte randbetween) wie change ich es also nicht Wiederhole die gleiche Nummer?

Sub Rand_Number() ‚AACO 20 àçåæ Ui îñôøé Aiai ÷ åìåú

Dim RandNum As Long 
Dim k As Long 
Dim Mone As Integer 

Mone = 0 
Num_molecules = Sheets("Data").Range("A14").Value 
RandNum = WorksheetFunction.RandBetween(1, Num_molecules) 

For j = 1 To Num_molecules * 0.2 

    If IsEmpty(Sheets("rand").Cells(1, 1)) = True Then 
      Sheets("rand").Cells(1, 1) = RandNum 

    Else 

    i = 1 
    'RandNum = WorksheetFunction.RandBetween(1, Num_molecules) 
      Do 'Until IsEmpty(Sheets("rand").Cells(i, 1)) = True 

      If Sheets("rand").Cells(i, 1) = RandNum Then 
      RandNum = WorksheetFunction.RandBetween(1, Num_molecules) 

      Do Until RandNum = Cells(i, 1) Or IsEmpty(Cells(i, 1)) = True 
       If RandNum = Sheets("rand").Cells(i, 1) Then 
        RandNum = WorksheetFunction.RandBetween(1, Num_molecules) 
       Else 
       i = i + 1 

       End If 
      Loop 


      ElseIf IsEmpty(Sheets("rand").Cells(i, 1)) = False Then 
      i = i + 1 

      Else 
      Sheets("rand").Cells(i, 1) = RandNum 

      Exit Do 

      End If 

     Loop 
    End If 


Next j 

End Sub

Answer 1

Ich würde empfehlen, ein Wörterbuch mit Spur der Zufallszahlen zu halten, die so erzeugt wurden, weit. Wenn die Nummer nicht im Wörterbuch vorhanden ist, können Sie mit der Simulation fortfahren, andernfalls könnten Sie eine neue Zufallszahl erzeugen (dies wäre die Else-Bedingung)

Verwenden eines Wörterbuchs ist sehr schnell für die Suche, wie die Schlüssel sind Hashed.

Hier ist ein Codebeispiel zum Arbeiten mit einem Wörterbuch.

Public Sub DictionaryExample() 
    Dim myDict   As Object: Set myDict = CreateObject("Scripting.Dictionary") 
    Dim myRand   As Long 
    Dim i    As Long 

    For i = 1 To 10000 
     myRand = WorksheetFunction.RandBetween(1, 10000) 
     If myDict.exists(myRand) = False Then ' The random number doesn't exist in the previous items added 
               'If it doesn't exist, add it to the dictionary 
      myDict.Add myRand, myRand 'First parameter is the key, or the unique value 
             'The second parameter is the value associated with the key, the lookup value 
     Else 
      'Do something here when it does exist 
     End If 
    Next i 
End Sub 

Answer 2

Generierung von Zahlen, bis alle Zahlen aus dem Bereich generiert sind. Es ist ineffizient, da gegen Ende des Algorithmus die meisten Zufallszahlen zu einem "Fehlschlag" werden, aber es ist immer noch effizienter als die Entfernungsmethode der Sammlung unten.

Sub uniqRndMissedHits() 

    Dim lb As Long: lb = 1 ' lower bound 
    Dim ub As Long: ub = 1000 ' upper bound 

    ' populate collection with numbers starting from lb to ub 
    Dim i As Long 
    Dim c As New Collection 

    ' iterate while we haven't generated all the random numbers 
    ' in the specified range 
    While c.Count < ub - lb + 1 
     i = Int((ub - lb + 1) * Rnd + lb) 
     If Not contains(c, CStr(i)) Then 
      c.Add i, CStr(i) 
      Debug.Print i ' this is your unique random number from the 
          ' remaining in the collection 
     End If 
    Wend 

End Sub 

Function contains(col As Collection, key As String) As Boolean 
    On Error Resume Next 
    col.Item key 
    contains = (Err.Number = 0) 
    On Error GoTo 0 
End Function 

Dieses Beispiel erzeugt einen garantierten einzigartigen (d.h. zuvor nicht erzeugt) Werte, sondern Remove Verfahren der Collection macht es für die große Anzahl von Simulationen ineffizient.

Sub uniqRnd() 

    Dim lb As Long: lb = 1 ' lower bound 
    Dim ub As Long: ub = 1000 ' upper bound 

    ' populate collection with numbers starting from lb to ub 
    Dim i As Long 
    Dim c As New Collection 
    For i = lb To ub: c.Add i: Next 

    ' randomly pick the number and (!) remove it from the 
    ' collection at the same time so it won't be repeated 
    While c.Count > 0 
     lb = 1 
     ub = c.Count 
     i = Int((ub - lb + 1) * Rnd + lb) 
     Debug.Print c(i) ' this is your unique random number from the 
         ' remaining in the collection 
     c.Remove i 
    Wend 

End Sub 

Vergleich der Leistungsdaten aller Methoden in dieser Antwort kann in diesem GitHub Gist Excel VBA: Generate complete set of unique random numbers