VBA中的氣體行爲

Question

我的項目是預測非理想的氣體運動，所以我寫了這個代碼給每個分子一個特定的數字，但它保持重複的數字（我用蘭德之間） 我如何改變它，所以它不會重複相同的號碼？

子Rand_Number（） 「AACO 20àçåæUIîñôøé艾艾÷åìåú

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 

末次

Answer 1

我推薦使用字典來跟蹤那些已經產生這樣的隨機數的遠。如果字典中不存在該數字，則可以繼續進行模擬，否則可以生成一個新的隨機數（這將成爲其他條件）

使用字典對查找操作非常快速，因爲密鑰被散列。

下面是如何使用字典的代碼示例。

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

生成數字，直到生成範圍內的所有數字。當算法結束時，大多數隨機數字變成「未命中」，但效率低下，但仍比下面的集合刪除方法更有效。

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 

此示例產生保證唯一的（即先前未產生）值，但Collection的Remove方法使得低效大量模擬。的這個回答所有的方法表現

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 

比較可以在此GitHub的要點Excel VBA: Generate complete set of unique random numbers