爲什麼第一個隨機數總是一樣的？

Question

我正在研究一個宏，爲隨機測試選擇隨機系列的員工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 

在此先感謝您的幫助。

Answer 1

爲了得到一個不同的第一號碼，只需添加一行，在你的函數開始說Randomize。

你可以員工的列表加載到一個數組，然後當選擇一個，從數組中刪除的員工，使他們不能再被選中。

CNC中

我想出了這個位的代碼應該爲你工作。它將員工ID加載到一個數組中，因此您不必處理選擇和重新排列操作緩慢的單元格。然後代碼從所有員工陣列中挑選員工，並將其添加到員工數組中進行檢查。然後，它將員工從所有員工陣列中移除，以便他們不會再被選中。一旦代碼選擇了需要檢查的員工數量，它就會將它們寫入所需的工作表中。

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 

您可能需要添加的檢查是專門針對您的數據集相關的（我只是用隨機整數少數的），你會想重新實現的方式供人選擇有多少員工檢查。