在VBA中编写一个子程序，以生成一个中奖彩票，其中包含从1到40随机抽取的6个整数。
为了获得一个小的模拟动画，范围（“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
我被卡在别处，sub test3（），在这里似乎不合适。我需要一些建议。另外，我为我糟糕的格式道歉，我是新手。
答案 0 :(得分：3)
像这样填充你的范围：
范围（＆＃34; A1：E8＆＃34;）应包含数字1到40
While生成一张中奖彩票，其中包含从1到40
随机抽取的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
循环中已挑选（并防止重复）的项目（直到选择了6个数字）：
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
方法执行＆＃34;暂停＆＃34;，您可以设置如下过程：
picked然后应该在范围内打印所绘制的中奖号码列表（＆＃34; G2：G7＆＃34;）。
打印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
全部放在一起：
var table = new DataTable();
for (int i = 0; i < 5; i++)
{
var row = table.NewRow();
table.Rows.Add(row);
}
注意这绝对不适用于Excel for Mac，您需要使用Collection而不是Dictionary，因为Scripting.Runtime库在Mac OS上不可用。
答案 1 :(得分：2)
除了David Zemens成员给出的优秀答案之外，以下是用＃34;纯粹＆＃34; Excel VBA，不包含任何Excel工作表函数，也不包含字典对象（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)
在LB ... UB范围内返回N个随机数的数组而不重复。
样本Sub GetRandomArray()演示了如何获得1 ... 10范围内的5个随机数并填充工作表范围：它可以针对任何特定要求进行定制（例如，在PO要求中为1 ... 40的8个）。
附录A（David Ziemens提供）
或者，您可以完全不依赖于Collection对象。构建一个分隔的字符串，然后使用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