|
Option Explicit
Sub test()
Dim arr, i, m, n, p, t, a, b
ReDim arr(1 To 16 ^ 5 + 6, 1 To 6), brr(1 To 33)
For i = 1 To UBound(brr): brr(i) = i: Next
m = 1
Do
Randomize
For i = 1 To UBound(brr)
p = Int(Rnd * (UBound(brr) - i + 1)) + i
t = brr(i): brr(i) = brr(p): brr(p) = t
n = n + 1: arr(m, n) = brr(i)
If n = 6 - b Then
m = m + 1: n = 0
a = a + 1
If a > 2 Then b = 1
End If
If n = 33 Then Exit For
Next
m = m + 3: n = 0: a = 0: b = 0
If m >= 16 ^ 5 Then m = 16 ^ 5: Exit Do
Loop
[a1].Resize(16 ^ 5, 6) = arr
End Sub |
|