为什么第一个随机数总是一样的？

我正在研究一个macros，它随机select一系列随机testing的员工ID号。 我的代码运行良好，除了返回的第一个数字总是相同的。 例如，如果我的身份证号码是1-100，我想要10个随机数字，那么第一个数字将始终为1，然后在随机数字中随机select。

作为一个额外的挑战，是否有可能使相同的数字将不被select，直到列表已经循环？

这是我正在使用的代码。

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 

在此先感谢您的帮助。

Answer 1

要获得不同的第一个数字，只需在function开始处添加一行说明Randomize的行。

您可以将员工列表加载到数组中，然后在select一个员工时，将该员工从数组中删除，以便他们不能再次被选中。

-编辑-

我想出了一些适合你的代码。 它将员工ID加载到一个数组中，因此您不必处理select和重新排列操作缓慢的单元格。 代码然后从所有员工的数组中挑选员工，并将其添加到一组员工中进行检查。 然后，将员工从所有员工的arrays中移除，这样他们就不能再被选中。 一旦代码select了需要检查的员工数量，就会将其写入所需的工作表中。

 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 

您可能需要添加与您的数据集特定相关的检查（我只是使用了一些随机整数），您将需要重新实施一种方法，让人们select要检查的雇员人数。