我正在研究一个宏,它选择一系列随机的员工 ID 号进行随机测试。我的代码运行良好,除了返回的第一个数字总是相同的。例如,如果我的 ID 号是 1-100,我想要 10 个随机数,那么第一个数字将始终为 1,然后是随机数。
作为一个额外的挑战,是否有可能在列表循环通过之前不会选择相同的数字?
这是我正在使用的代码。
Sub Macro1()
'
'
'
'
Dim CountCells
Dim RandCount
Dim LastRow
Dim Counter1
Dim Counter2
Worksheets.Add().Name = "Sheet1"
Worksheets("Employee ID#").Select
Range("a2:A431").Select
Selection.Copy
Worksheets("Sheet1").Select
Selection.PasteSpecial
Worksheets("Sheet1").Select
Range("A1").Select
CountCells = WorksheetFunction.Count(Range("A:A")) 'quantity of random numbers to pick from
If CountCells = 0 Then Exit Sub
On Error Resume Next
Application.DisplayAlerts = False
RandCount = Application.InputBox(Prompt:="How many random numbers do you want?", _
Title:="Random Numbers Selection", Type:=1)
On Error GoTo 0
Application.DisplayAlerts = True
RandCount = Int(RandCount)
If Int(RandCount) <= 0 Or RandCount = False Then Exit Sub
If RandCount > CountCells Then
MsgBox "Requested quantity of numbers is greater than quantity of available data"
Exit Sub
End If
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'clear working area
Range("B:C").ClearContents
'clear destination area
Range("Sheet2!A:A").ClearContents
'create index for sort use
Range("B1") = 1
Range(Cells(1, 2), Cells(LastRow, 2)).DataSeries , Step:=1
'create random numbers for sort
Range("C1") = "=RAND()"
Range("C1").Copy Range(Cells(1, 3), Cells(LastRow, 3))
'randomly sort data
Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'data has been sorted randomly, cells in column A, rows 1 through the quantity desired will be chosen
Counter1 = 1
Counter2 = 1
Do Until Counter1 > RandCount
If IsNumeric(Cells(Counter2, 1).Value) And Cells(Counter2, 1).Value <> Empty Then
Range("Sheet2!A" & Counter1) = Cells(Counter2, 1).Value
Counter1 = Counter1 + 1
'Selection.ClearContents
End If
Counter2 = Counter2 + 1
Loop
'resort data into original order and clear working area
Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B:C").ClearContents
Sheets("Sheet2").Select
'Sheets("Sheet2").PrintOut
End Sub
提前感谢您的帮助。
最佳答案
要获得不同的第一个数字,只需添加一行 Randomize
在您的功能开始时。
您可以将员工列表加载到一个数组中,然后在选择一个时,从数组中删除该员工,这样他们就不能再次被选中。
-编辑-
我想出了应该为你工作的这段代码。它将员工 ID#s 加载到一个数组中,因此您不必处理选择和重新排列单元格,这是一个缓慢的操作。然后代码从所有员工的数组中挑选员工,并将他们添加到员工数组中进行检查。然后它从所有员工的数组中删除员工,这样他们就不能再次被选中。一旦代码选择了需要检查的员工数量,它就会将它们写入所需的工作表中。
Sub SelectRandomEntries()
Dim WSEmp As Worksheet
Dim WSCheckedEmps As Worksheet
Dim AllEmps() As Long 'An array to hold the employee numbers
'Assuming Column A is an integer employee #
Dim CheckedEmps() As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim RandCount As Long
Dim RandEmp As Long
Dim i As Long
'Set the worksheets to variables. Make sure they're set to the appropriate sheets in YOUR workbook.
Set WSEmp = ThisWorkbook.Worksheets("Employee ID#") 'Sheet with all employees
Set WSCheckedEmps = ThisWorkbook.Worksheets("Checked Employees") 'Sheet with checked employees
FirstRow = 1
LastRow = WSEmp.Cells(WSEmp.Rows.Count, "A").End(xlUp).Row 'Find the last used row in a ColumnA
Randomize 'Initializes the random number generator.
'Load the employees into an array
ReDim AllEmps(FirstRow To LastRow) 'Make the array large enough to hold the employee numbers
For i = FirstRow To LastRow
AllEmps(i) = WSEmp.Cells(i, 1).Value
Next
'For this example, I sent RandCount to a random number between the first and last entries.
'Rnd() geneates a random number between 0 and 1 so the rest of line converts it to a usable interger.
RandCount = Int((LastRow - FirstRow + 1) * Rnd() + FirstRow)
MsgBox (RandCount & "will be checked")
ReDim CheckedEmps(1 To RandCount)
'Check random employees in the array
For i = 1 To RandCount
RandEmp = Int((LastRow - FirstRow + 1) * Rnd() + FirstRow) 'pick a random employee to check
If IsNumeric(AllEmps(RandEmp)) And AllEmps(RandEmp) <> Empty Then 'If the emp# is valid
CheckedEmps(i) = AllEmps(RandEmp) 'Move the employee to the checked employee list.
AllEmps(RandEmp) = Empty 'Clear the employee from the full list so they can't get picked again
Else
i = i - 1 'If you checked a RandEmp that wasn't suitable, you'll need to check another one.
End If
Next
'Write the employees to the results sheet
For i = 1 To RandCount
WSCheckedEmps.Cells(i, 1) = CheckedEmps(i)
Next i
End Sub
您可能需要添加与您的数据集特别相关的检查(我只是使用了一些随机整数),并且您需要重新实现一种方法,让人们选择检查多少员工。
关于excel - 为什么第一个随机数总是一样的?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/17046713/