Const u = 5
Const v = 59
Const num = 5000
Sub lottonumbers()
Dim b() As Boolean, z(), a()
Dim c As String, d As Object
Dim i&, x&
ReDim a(1 To 10 ^ 6, 1 To 1)
Set d = CreateObject("scripting.dictionary")
Do
ReDim z(1 To v), b(v)
c = vbNullString
For i = 1 To v: z(i) = i: Next i
For i = 1 To u
x = Int(Rnd * (v - i + 1)) + i
tmp = z(i): z(i) = z(x): z(x) = tmp
b(z(i)) = True
Next i
For i = 1 To v
If b(i) Then c = c & "-" & i
Next i
c = Right(c, Len(c) - 1)
If d(c) <> 1 Then
d(c) = 1
a(d.Count, 1) = c
End If
Loop Until d.Count = num
Cells(1).Resize(num) = a
End SubI can't get much sense from your sets of numbers in post#15, nor is clear to me what you mean in post#16.
This seems a somewhat bizarre request to me.
Option Explicit
Const u = 5
Const v = 59
Const num = 20
Const mx = 10 ^ 6
Sub lottonumbers2()
Dim b() As Boolean
Dim c(), d As Object, a, w As String
Dim i&, j&, k&, x&, q&, nr&
nr = Range("A1").End(xlDown).Row
a = Range("A1:A" & nr)
Range("B2:C" & nr).ClearContents
Randomize
For j = 2 To nr
For q = 1 To mx
ReDim b(v), c(1 To u)
k = 0
Do
x = Int(Rnd * v) + 1
If b(x) = False Then
k = k + 1
b(x) = True
End If
Loop Until k = 5
k = 0
For i = 1 To v
If b(i) Then k = k + 1: c(k) = i
Next i
w = Join(c, "-")
If w = a(j, 1) Then
Cells(j, 2) = w
Cells(j, 3) = q
Exit For
End If
Next q
If Cells(j, 3) = "" Then Cells(j, 3) = mx
Next j
End Sub
