Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Mamae
 | Femeie
21 ani
Constanta
cauta Barbat
26 - 42 ani |
|
Mrrrr
AdMiN
 Inregistrat: acum 18 ani
Postari: 2247
|
|
Source:
The code below extracts X numbers / names / whatever from Range A:A to D1:D7.
X depends on the value you put in cell B1.
' the code below extracts X numbers/names etc. from range A:A to D1:D7
' X depends on value in cell B1
Sub PickRandomFromList()
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 = Range("B1").Value 'in B1 put the number of items you want extracted
CellsOut = 1 'means row 1
ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("A:A")) ' Find how many names in the list;
' add - 1 at the end of the line above if your list has headers
i = 1
Do While i <= HowMany
RandomNo:
RandomNumber = Application.RandBetween(1, NoOfNames)
'Check to see if the name has already been picked
For ArI = LBound(Names) To UBound(Names)
If Names(ArI) = Cells(RandomNumber, 1).Value Then
GoTo RandomNo
End If
Next ArI
Names(i) = Cells(RandomNumber, 1).Value ' Assign random name to the array
i = i + 1
Loop
'Loop through the array and enter items onto the worksheet
For ArI = LBound(Names) To UBound(Names)
Cells(CellsOut, 3) = Names(ArI)
CellsOut = CellsOut + 1
Next ArI
Application.ScreenUpdating = True
End Sub |
_______________________________________
|
|
| pus acum 5 ani |
|
Mrrrr
AdMiN
Inregistrat: acum 18 ani
Postari: 2247
|
|
Updated.
The code never extracted the 1st item (position 1 in the list) - it was always the last one remaining if all were being extracted. And when putting just 2 items (so 50% chance to extract each), the 2nd was always being extracted.
Code fixed now.
Modified row:
RandomNumber = Application.RandBetween(2, NoOfNames + 1)
to
RandomNumber = Application.RandBetween(1, NoOfNames)
_______________________________________
|
|
| pus acum 5 ani |
|