我想從 excel 中的列中選擇隨機名稱，如下所示：
-在第一張“Inscrp”是串列所在的地方，第二張“Tirage”是挑選結果的地方。
- 作業表“Tirage”中的 A 列應該從作業表“Inscrp”中的 A 列中選擇隨機名稱，對于 B、C 列也是如此，直到我選擇的列數我只用第一列和這是代碼：
Sub PickNamesAtRandom()
Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes
Application.ScreenUpdating = False
HowMany = 5
CellsOut = 8
ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Worksheets("Inscrp").Range("A3:A100")) - 1 ' Find how many names in the list
i = 1
Do While i <= HowMany
RandomNo:
RandomNumber = Application.RandBetween(3, NoOfNames 1)
'Check to see if the name has already been picked
For ArI = LBound(Names) To UBound(Names)
If Names(ArI) = Worksheets("Inscrp").Cells(RandomNumber, 1).Value Then
GoTo RandomNo
End If
Next ArI
Names(i) = Worksheets("Inscrp").Cells(RandomNumber, 1).Value ' Assign random name to the array
i = i 1
Loop
'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)
Worksheets("Tirage").Cells(CellsOut, 1) = Names(ArI)
CellsOut = CellsOut 1
Next ArI
Application.ScreenUpdating = True
End Sub
uj5u.com熱心網友回復：
請測驗下一個代碼。如果我正確理解您的需求，它將從“Inscrip”表的每一列（ ）中提取HowMany亂數，并從“Tirage”表開始放置。已經提取的名稱從它曾經存在的陣列中洗掉（以避免重復名稱）。范圍 ar 放置在陣列中，因此，代碼應該非常快，主要在記憶體中作業，即使對于大范圍：nrColCellsOut
Sub PickNamesAtRandom()
Dim shI As Worksheet, lastR As Long, shT As Worksheet, HowMany As Long
Dim rndNumber As Integer, Names() As String, i As Long, CellsOut As Long
HowMany = 5: CellsOut = 8
Set shI = Worksheets("Inscrp")
Set shT = Worksheets("Tirage")
Dim col As Long, arrCol, filt As String, nrCol As Long
nrCol = 2 'number of columns to be returned. It can be changed and also be calculated...
For col = 1 To nrCol
lastR = shI.cells(shI.rows.count, col).End(xlUp).Row 'last row in column to be processed
If lastR >= HowMany 2 Then ' 2 because the range is build starting with the third row...
arrCol = Application.Transpose(shI.Range(shI.cells(3, col), shI.cells(lastR, col)).Value2) 'place the range in a 1D array
ReDim Names(1 To HowMany) 'Set the array size to how many names required
For i = 1 To UBound(Names)
tryAgain:
Randomize
rndNumber = Int((UBound(arrCol) - LBound(arrCol) 1) * Rnd LBound(arrCol))
If arrCol(rndNumber) = "" Then GoTo tryAgain
Names(i) = arrCol(rndNumber)
filt = arrCol(rndNumber) & "##$$@": arrCol(rndNumber) = filt
arrCol = filter(arrCol, filt, False) 'eliminate the already used name from the array
Next i
shT.cells(CellsOut, col).Resize(UBound(Names), 1).Value2 = Application.Transpose(Names)
End If
Next col
MsgBox "Ready..."
End Sub
如果有不清楚的地方，請不要猶豫，要求澄清......
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/484138.html