Excel VBA中得到隨機整數，而不重複

Question

寫VBA的子程序，以產生中獎彩票票爲由1隨機抽取6個整數的〜40

爲了具有小的模擬動畫，範圍（ 「A1：E8」）應該包含數字1到40，然後子程序應該使用彩色單元格循環這些數字，然後暫停選定的獲勝數字2秒。然後應在範圍（「G2：G7」）中打印所繪中獎號碼列表。如果已經在列表中繪製了一個數字，那麼應該重新繪製一個新數字。

我只能做到如下。

Option Explicit 
Sub test1() 
    Sheet1.Cells.Clear 
    Dim i As Integer 
    For i = 1 To 40 
     Cells(i, 1) = i 
    Next 
End Sub 

'----------------------------- 
Option Explicit 
Option Base 1 

Function arraydemo(r As Range) 
    Dim cell As Range, i As Integer, x(40, 1) As Double 
    i = 1 
    For Each cell In r 
     x(i, 1) = cell.Value 
     i = i + 1 
    Next cell 
    arraydemo = x 
End Function 
Sub test3() 
    Dim x() As String 
    chose = Int(Rnd * UBound(x)) 
End Sub 

我被卡在其他地方，子測試3（），在這裏似乎不太合適。我需要一些建議。另外，我爲我糟糕的格式編寫了appologise，我對此很陌生。

Answer 1

填充您的範圍是這樣的：

範圍（ 「A1：E8」）應包含的數字1到40

Sheet1.Cells.Clear 

Dim i As Integer 
Dim rng as Range 
Set rng = Range("A1:E8") 
For i = 1 To 40 
    rng 
Next  

產生中獎彩票票由6個隨機抽取的整數從1到40

使用dictio進制對象來跟蹤這些項目都被接走（和防止重複）在While循環（直到有選擇6個號碼）：

Dim picked as Object 
Set picked = CreateObject("Scripting.Dictionary") 
'Select six random numbers: 
i = 1 
While picked.Count < 6 
    num = Application.WorksheetFunction.RandBetween(1, 40) 
    If Not picked.Exists(num) Then 
     picked.Add num, i 
     i = i + 1 
    End If 
Wend 

使用Application.Wait方法做了「暫停」，您可以設置一個程序像這樣：

'Now, show those numbers on the sheet, highlighting each cell for 2 seconds 
For Each val In picked.Keys() 
    rng.Cells(picked(val)).Interior.ColorIndex = 39 'Modify as needed 
    Application.Wait Now + TimeValue("00:00:02") 
    rng.Cells(picked(val)).Interior.ColorIndex = xlNone 
Next 

獲勝繪製然後應在範圍被印刷號碼的列表（「G2：G7」）。

打印從picked字典中的鍵：

Range("G2:G7").Value = Application.Transpose(picked.Keys()) 

全部放在一起：

Sub Lotto() 
    Dim i As Integer, num As Integer 
    Dim rng As Range 
    Dim picked As Object 'Scripting.Dictionary 
    Dim val As Variant 


    'Populate the sheet with values 1:40 in range A1:E8 
    Set rng = Range("A1:E8") 
    For i = 1 To 40 
     rng.Cells(i) = i 
    Next 

    'Store which numbers have been already chosen 
    Set picked = CreateObject("Scripting.Dictionary") 

    'Select six random numbers: 
    i = 1 
    While picked.Count < 6 
     num = Application.WorksheetFunction.RandBetween(1, 40) 
     If Not picked.Exists(num) Then 
      picked.Add num, i 
      i = i + 1 
     End If 
    Wend 

    'Now, show those numbers on the sheet, highlighting each cell for 2 seconds 
    For Each val In picked.Keys() 
     rng.Cells(val).Interior.ColorIndex = 39 'Modify as needed 
     Application.Wait Now + TimeValue("00:00:02") 
     rng.Cells(val).Interior.ColorIndex = xlNone 
    Next 

    'Display the winning series of numbers in G2:G7 
    Range("G2:G7").Value = Application.Transpose(picked.Keys()) 
End Sub 

注意這絕對不會爲Mac電腦上的Excel工作，你會需要使用Collection而不是Dictionary，因爲Scripting.Runtime庫在Mac O上不可用S.

Answer 2

除了成員David Zemens給出的優秀答案，以下是用「純」Excel VBA編寫的通用函數，它不包含任何Excel工作表函數，也不包含Dictionary對象（re：CreateObject("Scripting.Dictionary"）。

Option Explicit 

'get N random integer numbers in the range from LB to UB, NO repetition 
'general formula: Int ((UpperBound - LowerBound + 1) * Rnd + LowerBound) 
Function RandomNumbers(LB As Integer, UB As Integer, N As Integer) As Variant 
    Dim I As Integer 
    Dim arrRandom() As Integer 
    Dim colRandom As New Collection 
    Dim colItem As Variant 
    Dim tempInt As Integer 
    Dim tempExists As Boolean 

    'check that ArraySize is less that the range of the integers 
    If (UB - LB + 1 >= N) Then 

     While colRandom.Count < N 

      Randomize 
      ' get random number in interval 
      tempInt = Int((UB - LB + 1) * Rnd + LB) 

      'check if number exists in collection 
      tempExists = False 
      For Each colItem In colRandom 
       If (tempInt = colItem) Then 
        tempExists = True 
        Exit For 
       End If 
      Next colItem 

      ' add to collection if not exists 
      If Not tempExists Then 
       colRandom.Add tempInt 
      End If 
     Wend 

     'convert collection to array 
     ReDim arrRandom(N - 1) 
     For I = 0 To N - 1 
      arrRandom(I) = colRandom(I + 1) 
     Next I 

     'return array of random numbers 
     RandomNumbers = arrRandom 
    Else 
     RandomNumbers = Nothing 
    End If 
End Function 

'get 5 Random numbers in the ranger 1...10 and populate Worksheet 
Sub GetRandomArray() 
    Dim arr() As Integer 

    'get array of 5 Random numbers in the ranger 1...10 
    arr = RandomNumbers(1, 10, 5) 

    'populate Worksheet Range with 5 random numbers from array 
    If (IsArray(arr)) Then 
     Range("A1:A5").Value = Application.Transpose(arr) 
    End If 
End Sub 

功能

Function RandomNumbers(LB As Integer, UB As Integer, N As Integer) 

返回N個隨機數的陣列中的範圍LB ... UB包含地不重複。

示例Sub GetRandomArray()演示瞭如何獲得1到10範圍內的5個隨機數字並填充工作表範圍：它可以針對任何特定要求（例如PO需求中的1 ... 40中的8）進行自定義。

---

附錄A（大衛Ziemens提供）

或者，你可以不用依靠收集對象上都類似。構建一個分隔字符串，然後使用Split函數將字符串轉換爲數組，然後將其返回給調用過程。

這實際上返回的數字爲String，但這對於這個特殊的用例應該不重要，如果是這樣，可以很容易地進行修改。

Option Explicit 
Sub foo() 
Dim arr As Variant 

arr = RandomNumbersNoCollection(1, 40, 6) 

End Sub 


'get N random integer numbers in the range from LB to UB, NO repetition 
'general formula: Int ((UpperBound - LowerBound + 1) * Rnd + LowerBound) 
Function RandomNumbersNoCollection(LB As Integer, UB As Integer, N As Integer) 
    Dim I As Integer 
    Dim numbers As String ' delimited string 
    Dim tempInt As Integer 
    Const dlmt As String = "|" 

    'check that ArraySize is less that the range of the integers 
    If (UB - LB + 1 >= N) Then 

      ' get random number in interval 
     Do 
      Randomize 
      tempInt = Int((UB - LB + 1) * Rnd + LB) 
      If Len(numbers) = 0 Then 
       numbers = tempInt & dlmt 
      ElseIf InStr(1, numbers, tempInt & dlmt) = 0 Then 
       numbers = numbers & tempInt & dlmt 
      End If 

     Loop Until UBound(Split(numbers, dlmt)) = 6 
     numbers = Left(numbers, Len(numbers) - 1) 
    End If 
    RandomNumbersNoCollection = Split(numbers, dlmt) 

End Function