Cuantos números de 4 cifras pueden salir en excel

Me di a la tarea de buscar y encontré esta macro que funciona de maravilla

Sub genera_Variaciones_ejemplo_hoja_Consulta()
Dim Vec, Q&, i&, C As Range

[f1].CurrentRegion.Delete xlShiftUp
Application.ScreenUpdating = False

With [a1].CurrentRegion
Q = .Count: ReDim Vec(1 To Q)
For Each C In .Cells: i = 1 + i: Vec(i) = C: Next

Application.Run "Hoja82.c_v_Determinación", Vec, Q, 4, "V"
Application.ScreenUpdating = False

ActiveSheet.[a1].CurrentRegion.Copy .Worksheet.[f1]
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End With

Application.ScreenUpdating = True
End Sub

Sub Combinaciones_Variaciones()
Dim Vec, iniTime!

iniTime = Timer
[a7] = ""

Application.ScreenUpdating = False
Vec = Application.Transpose(Range("c2", [c1].End(xlDown)))
c_v_Determinación Vec, UBound(Vec), [a4], UCase(Left([a1], 1))

[a7] = "generados en " & Format(Timer - iniTime, "0.0000") & " seg."
Application.ScreenUpdating = True
End Sub

Private Sub c_v_Determinación(Vec1, NN&, MM%, Tipo$)
'------------------
'by Cacho Rodríguez
'------------------
Dim qCeldas#

If MM < 1 Then Msg 1
If NN < MM Then Msg 2

qCeldas = CDbl(ActiveSheet.Rows.Count) * CDbl(ActiveSheet.Columns.Count)

If Tipo = "C" And Application.Combin(NN, MM) > qCeldas Then Msg 3
If Tipo = "V" And Application.Permut(NN, MM) > qCeldas Then Msg 3

With ActiveCell
Set ws = Worksheets.Add(after:=.Worksheet)
Application.GoTo .Cells, False
End With

If Tipo = "C" Then
Combinaciones Vec1, NN, MM
ElseIf Tipo = "V" Then
Variaciones Vec1, NN, MM
End If

Application.GoTo ws.Cells(1), True
End Sub

Private Sub Combinaciones(Vec1, NN&, MM%, Optional V As Boolean = False)
Dim Vec2, i%, piv%, r_Mat&, Vec3

ReDim Mat(1 To mMat, 1 To 1)

If V Then
Close
Open Environ("Temp") & "\CachoR.txt" For Output As #82
Else
iRow = 1: iCol = 1
End If

ReDim Vec2(1 To MM)
ReDim Vec3(1 To MM)

For i = 1 To MM
Vec2(i) = i
Next
piv = MM: r_Mat = 0

Do
For i = 1 To MM
Vec3(i) = Vec1(Vec2(i))
Next

r_Mat = 1 + r_Mat
Mat(r_Mat, 1) = Join(Vec3, "|")

If r_Mat = mMat Then
Guardar r_Mat, V
r_Mat = 0
End If
Vec2(piv) = 1 + Vec2(piv)
If Vec2(piv) > NN Then
Do
If piv = 1 Then
Guardar r_Mat, V
Exit Sub
End If
piv = piv - 1
If Vec2(piv) < NN - (MM - piv) Then Exit Do
Loop
Vec2(piv) = 1 + Vec2(piv)
For i = 1 + piv To MM
Vec2(i) = 1 + Vec2(i - 1)
Next
piv = MM
End If
Loop

End Sub

Private Sub Variaciones(Vec1, NN&, MM%)
Dim Vec2, r_Mat&, iLine, i&, j%, Vec3

Combinaciones Vec1, NN, MM, True
Close #82

Vec2 = Permutaciones(MM)
ReDim Vec3(1 To MM)
ReDim Mat(1 To mMat, 1 To 1)

Open Environ("Temp") & "\CachoR.txt" For Input As #82
r_Mat = 0
iRow = 1: iCol = 1

Do Until EOF(82)
Line Input #82, iLine
iLine = Split(iLine, "|")
For i = 1 To UBound(Vec2)
For j = 1 To MM
Vec3(j) = iLine(Vec2(i, j) - 1)
Next
r_Mat = 1 + r_Mat
Mat(r_Mat, 1) = Join(Vec3, "|")
If r_Mat = mMat Then
Guardar r_Mat, False
r_Mat = 0
End If
Next
Loop

If r_Mat > 0 Then Guardar r_Mat, False

End Sub

Private Function Permutaciones(Q%)
Dim Vec1, Vec2, i&, piv%, R&, j%, k&

ReDim Vec2(1 To 1, 1 To 1)
Vec2(1, 1) = 1

Do Until UBound(Vec2, 2) = Q
Vec1 = Vec2
ReDim Vec2(1 To UBound(Vec1, 1) * (1 + UBound(Vec1, 2)), 1 To (1 + UBound(Vec1, 2)))

For i = 1 To UBound(Vec2, 1)
k = 1 + (i - 1) Mod UBound(Vec2, 2)
For j = 1 To UBound(Vec2, 2)
Select Case True
Case k < j
Vec2(i, j) = Vec1(1 + Int((i - 1) / UBound(Vec2, 2)), j - 1)
Case k = j
Vec2(i, j) = UBound(Vec2, 2)
Case k > j
Vec2(i, j) = Vec1(1 + Int((i - 1) / UBound(Vec2, 2)), j)
End Select
Next
Next
Loop

Permutaciones = Vec2

End Function

Private Sub Guardar(r_Mat&, V As Boolean)
Dim i&

'DoEvents
On Error GoTo eTrap
If V Then
For i = 1 To r_Mat
Print #82, Mat(i, 1)
Next
Else
ws.Cells(iRow, iCol).Resize(r_Mat) = Mat
iRow = iRow + r_Mat
End If
On Error GoTo 0
Exit Sub

eTrap:
iRow = 1: iCol = 1 + iCol
Resume
End Sub

Private Sub Msg(Caso%)
Dim iMsg$

Select Case Caso
Case 1: iMsg = "El número de elementos de cada grupo" & vbLf & "debe ser un entero mayor que cero."
Case 2: iMsg = "El número de elementos de cada grupo" & vbLf & "NO debe ser mayor al número total de elementos."
Case 3: iMsg = "El número de grupos a generar supera a la cantidad de celdas de la hoja."
End Select

MsgBox iMsg
End
End Sub

Para permutaciones son 20,736 arreglos posibles, para combinaciones son 495 arreglos únicos y la macro para conseguir todos los arreglos posibles en ambos con la siguiente macro consigues ambos arreglos en un solo paso dura menos de 1 minuto generar todos los arreglos

Sub genera_permutacionycombina()
Set DATOS = Range("a1").CurrentRegion
FILAS = DATOS.Cells.Count

Permutaciones = 12 ^ 4
Combinaciones = WorksheetFunction.Combin(FILAS, 4)

With Range("F1")
.Value = "PERMUTACIONES TOTALES: " & Permutaciones
.Font.Bold = True
End With

With Range("F2")
.Value = "COMBINACIONES TOTALES: " & Combinaciones
.Font.Bold = True
End With

Set PERMUTA = Range("F6").Resize(Permutaciones, 4)
Set COMBINA = Range("K6").Resize(Combinaciones, 4)

MATRIZ = PERMUTA: MATRIZA = COMBINA

X = 1: Y = 1
For a = 1 To 12
For B = 1 To 12
For C = 1 To 12
For D = 1 To 12
On Error Resume Next
MATRIZ(X, 1) = DATOS.Cells(a)
MATRIZ(X, 2) = DATOS.Cells(B)
MATRIZ(X, 3) = DATOS.Cells(C)
MATRIZ(X, 4) = DATOS.Cells(D)
If B > a And C > B And D > C Then
MATRIZA(Y, 1) = DATOS.Cells(a)
MATRIZA(Y, 2) = DATOS.Cells(B)
MATRIZA(Y, 3) = DATOS.Cells(C)
MATRIZA(Y, 4) = DATOS.Cells(D)
Y = Y + 1
End If
On Error GoTo 0
X = X + 1
Next D
Next C
Next B
Next a
Range(PERMUTA.Address) = MATRIZ
Range(COMBINA.Address) = MATRIZA
End Sub