|
Selecting a random subset without repeating -- using a user defined
function (UDF) There are
three procedures described below. Each is a variant of an
efficient single-pass algorithm for generating a random selection
from a specified list.
A worksheet range
contains the list from which the random selections are made.
Return a specified
number of random numbers from a set of numbers with a specified
lower and upper values
Return a specified
number of random values from an user specified array
A worksheet range contains the list from
which the random selections are made.
The code below
goes into a normal module. The function RandomSelection is
then available for use in a spreadsheet. Typically, the
function should be used as an array-formula. The function
takes a single argument, a worksheet range from the random
selections are to be made. How many selections depends on the
number of cells selected for array-entering the function.
Option Explicit
Function RandomSelection(aRng As Range)
Dim myTarg
As Range, _
SrcList, Rslt(), _
i As Long, j As Long, k As Long
Application.Volatile
SrcList = aRng.Value
Set myTarg = Application.Caller
With myTarg
If .Areas.Count > 1 Then
RandomSelection = _
"Function can be used only in a single contiguous
range"
Exit Function '<<<<<
End If
If .Rows.Count > 1 And .Columns.Count > 1 Then
RandomSelection = _
"Selected cells must be in a single row or
column"
Exit Function '<<<<<
End If
If .Cells.Count > aRng.Cells.Count Then
RandomSelection = _
"Range specified as argument must contain more
cells than output selection"
Exit Function '<<<<<
End If
ReDim Rslt(1 To IIf(.Rows.Count > 1, .Rows.Count, .Columns.Count))
End With
j = UBound(SrcList, 1)
For i = LBound(Rslt) To UBound(Rslt)
k = Int(Rnd() * (j - LBound(SrcList,
1) + 1)) + LBound(SrcList, 1)
Rslt(i) = SrcList(k, 1)
SrcList(k, 1) = SrcList(j, 1)
j = j - 1
Next i
If myTarg.Rows.Count > 1 Then
RandomSelection =
Application.WorksheetFunction.Transpose(Rslt)
Else
RandomSelection = Rslt
End If
End Function |
Return a specified number of
random numbers from a set of numbers with a specified
lower and upper values
This is a variant of a single pass
algorithm that generates Amount random numbers from a
list of numbers with the lowest number specified by Bottom
and the highest number specified by Top.
While this can be used as a UDF,
the more likely use will be to call it from another VBA
procedure. As a UDF, it would be used as in
=TMOptRands(11, 20,5),
which returns 5 random numbers from the set (11, 12,...,19, 20).Public Function
TMOptRands(Bottom As Long, Top As Long, _
Amount As Long) As Variant
Dim i As Long, r As Long, temp As Long
ReDim iArr(Bottom To Top) As Long
For i = Bottom To Top: iArr(i) = i: Next i
For i = 1 To Amount
r = Int(Rnd() * (Top - Bottom + 1 - (i
- 1))) _
+ (Bottom + (i
- 1))
temp = iArr(r): iArr(r) = iArr(Bottom
+ i - 1): _
iArr(Bottom +
i - 1) = temp
Next i
ReDim Preserve iArr(Bottom To Bottom + Amount - 1)
TMOptRands = iArr
End Function
|
Return a specified number of random
values from an user specified array
This is a variant of a single pass
algorithm that returns N random elements from the
contents of Arr. The same array is used to return
the numbers and can be reused to create another list.
The N random numbers are returned in the upper N array
elements. While this can be
used as a UDF, the more likely use will be to call it
from another VBA procedure. One way to use this function
as a UDF would be =RandomSelect({101,
34, 55, 12.},2). The example returns 2 random
numbers from 101, 34, 55, 12.Sub
Swap(ByRef Arr() As Variant, ByVal i As Long, ByVal j As
Long)
Dim temp As Variant
temp = Arr(i): Arr(i) = Arr(j): Arr(j)
= temp
End Sub
Sub RandomSelect(ByRef Arr() As Variant, ByVal N As
Long)
'Returns N elements out of m, the size of Arr _
The upper N elements of the
array will contain the _
unique random values
Dim i As Long, thisIdx As Long
'Need edits to
ensure Arr is an acceptable data type. _
Similarly, validate n
For i = 1 To N
thisIdx = LBound(Arr) _
+
Int((UBound(Arr) - (i - 1) - LBound(Arr) + 1) * Rnd())
Swap Arr, UBound(Arr) - (i - 1),
thisIdx
Next i
End Sub
|
|
|
