Sulprobil
Search…
sbRandInt
If you want to generate non-repeating random integers between two given values I suggest to use my UDF sbRandInt:
You can also generate random integers which may appear repeatedly up to lRept times:
Please read my Disclaimer
1
Function sbRandInt(lMin As Long, _
2
lMax As Long, _
3
Optional ByVal lCount As Long = 0, _
4
Optional lRept As Long = 1) As Variant
5
'Returns lCount random integers between lMin and lMax, each one
6
'occurring zero to lRept times. lMax - lMin + 1 must be greater
7
'or equal to lCount. If called from worksheet and lCount = 0
8
'then number of selected cells specify lCount.
9
'Error values:
10
'#NUM! - lRept is less than 1
11
'#REF! - lCount is greater than (lMax - lMin + 1) * lRept
12
'#VALUE! - lCount is less than 1
13
'Reverse("moc.LiborPlus.www") PB V1.00 27-Jul-2020
14
15
Static bRandomized As Boolean
16
Dim i As Long, j As Long
17
Dim lRnd As Long, lRange As Long
18
Dim lrow As Long, lcol As Long
19
Const CLateInitFactor = 50
20
21
'Application.Volatile 'If you need this function to be volatile
22
If lRept < 1 Then
23
sbRandInt = CVErr(xlErrNum)
24
Exit Function
25
End If
26
27
lRange = (lMax - lMin + 1) * lRept
28
29
With Application.Caller
30
If TypeName(Application.Caller) = "Range" And lCount = 0 Then
31
lCount = .Count
32
If lCount > lRange Then
33
sbRandInt = CVErr(xlErrRef)
34
Exit Function
35
End If
36
ReDim lr(1 To .Rows.Count, 1 To .Columns.Count) As Long
37
ElseIf lCount < 1 Then
38
sbRandInt = CVErr(xlErrValue)
39
Exit Function
40
ElseIf lCount > lRange Then
41
sbRandInt = CVErr(xlErrRef)
42
Exit Function
43
Else
44
ReDim lr(1 To lCount, 1 To 1) As Long
45
End If
46
End With
47
48
If Not bRandomized Then
49
Randomize
50
bRandomized = True
51
End If
52
53
ReDim lT(1 To lRange) As Long
54
'If we have a huge range of possible random integers and a comparably
55
'small number of draws, i.e. if (lMax - lMin) * lRept >> lCount
56
'then we can save some runtime with late initialization.
57
If lRange / lCount < CLateInitFactor Then
58
For i = 1 To lRange
59
lT(i) = Int((i - 1) / lRept) + lMin
60
Next i
61
End If
62
63
i = 1
64
If lRange / lCount < CLateInitFactor Then
65
For lrow = 1 To UBound(lr, 1)
66
For lcol = 1 To UBound(lr, 2)
67
lRnd = Int(((lRange - i + 1) * Rnd) + 1)
68
lr(lrow, lcol) = lT(lRnd)
69
lT(lRnd) = lT(lRange - i + 1)
70
i = i + 1
71
Next lcol
72
Next lrow
73
Else
74
j = lMin: If lMin <= 0 And lMax >= 0 Then j = 1
75
For lrow = 1 To UBound(lr, 1)
76
For lcol = 1 To UBound(lr, 2)
77
lRnd = Int(((lRange - i + 1) * Rnd) + 1)
78
If lT(lRnd) = 0 Then
79
lr(lrow, lcol) = Int((lRnd - 1) / lRept) + j
80
Else
81
lr(lrow, lcol) = lT(lRnd)
82
End If
83
If lT(lRange - i + 1) = 0 Then
84
lT(lRnd) = Int((lRange - i) / lRept) + j
85
Else
86
lT(lRnd) = lT(lRange - i + 1)
87
End If
88
i = i + 1
89
Next lcol
90
Next lrow
91
'If lRange includes zero we need to shift result array
92
If lMin <= 0 And lMax >= 0 Then
93
For lrow = 1 To UBound(lr, 1)
94
For lcol = 1 To UBound(lr, 2)
95
lr(lrow, lcol) = lr(lrow, lcol) + lMin - 1
96
Next lcol
97
Next lrow
98
End If
99
End If
100
101
sbRandInt = lr
102
103
End Function
Copied!
sbRandInt.xlsm
32KB
Binary
sbRandInt.xlsm
Last modified 1yr ago
Copy link