Option Explicit
Private SizeArray As Integer
Private Valores()  As Byte
 
Private Function GetArrayDeValores(ByVal Cantidad As Byte) As Byte()
     Dim V() As Byte, v18() As String
     Const Val18 As String = "4, 6, 14, 18, 19, 20, 21, 24, 26, 27, 31, 32, 35, 36, 40, 41, 42, 47, 49"
     Const Val19 As String = 33
     Const Val20 As String = 11
     Dim i As Integer
     Dim k As Integer
     If ((Cantidad < 18) Or (Cantidad > 20)) Then
           MsgBox "No se ha contemplado el caso de un array con " & CStr(Cantidad) & " de ítems... " & vbCrLf & "Valores aceptados actualmente: 18-20"
          SizeArray = 0
    Else
         v18 = Split(Val18, ", ")   ' pasamos la constante a un array de strings
         ReDim V(0 To Cantidad - 1) ' dimsnesionamos el array en la cantidad deseada
         For k = 0 To 18               ' pasamos los 18 valores del array de strings al array de bytes
             V(k) = CByte(v18(k))
         Next
         If (Cantidad >= 19) Then V(18) = Val19  ' Si se solicitó 19 o 20 valores, pasamos el 19º
         If (Cantidad = 20) Then V(19) = Val20  ' ídem para el 20º
 
         SizeArray = Cantidad
         GetArrayDeValores = V   ' devolvemos el array al tamaño solicitado y con los valores asignados.
    End If
End Function


    Private Sub CombinacionesDe6(ByVal Cantidad As Byte)
        Dim Max As Integer, combinacion  As String
        Dim i As Integer, j As Integer, k As Integer, l As Integer, m As Integer, n As Integer
     
        Valores = GetArrayDeValores(Cantidad)
        If (SizeArray > 0) Then
             List1.Clear
             List1.Visible = False   ' Esto hará que el añadido sea mucho más rápido
             Max = UBound(Valores)
     
              For i = 0 To Max - 5
                  For j = i + 1 To Max - 4
                      For k = j + 1 To Max - 3
                          For l = k + 1 To Max - 2
                              For m = l + 1 To Max - 1
                                  For n = m + 1 To Max
                                      '.... lo que sea que vayas a hacer... por ejemplo añadirlos al listbox
                                       combinacion = ConcatValues(CStr(Valores(i)), CStr(Valores(j)), CStr(Valores(k)), CStr(Valores(l)), CStr(Valores(m)), CStr(Valores(n)))
                                       List1.AddItem combinacion
                                  Next
                              Next
                          Next
                      Next
                  Next
              Next
     
              List1.Visible = True
              Text1.Text = List1.ListCount  ' el añadido es bastante rápido, no hace falta ponerlo más que al final, o en todo caso en un bucle previo (si fueran a meterse muchos miles)
        End If
    End Sub
     
Private Function ConcatValues(i As String, j As String, k As String, l As String, m As String, n As String) As String
      ConcatValues = Format2Digitos(i) & Format2Digitos(j) & Format2Digitos(k) & Format2Digitos(l) & Format2Digitos(m) & Format2Digitos(n)
End Function
 
' Formato: 2espacios + valor(2 dígitos) + espacio(s) + separador
Private Function Format2Digitos(ByRef Valor As String, Optional ByVal Size As Byte = 8, Optional ByRef Separador As String = "|") As String
    Dim Salida As String, k As Integer
    Dim ConcatValues As String
    If (Len(Valor) = 1) Then
        Salida = ("  0" & Valor)
    Else
        Salida = ("  " & Valor)
    End If
 
    k = (Len(Salida) + Len(Separador) - Size)
    If (k > 0) Then Salida = Salida & Space$(k)
 
    ConcatValues = (Salida & Separador)
End Function

Private Sub Form_Load()
CombinacionesDe6 20
End Sub

Option Explicit


Private Sub MakeUniqueCombinationOfSix(AryOfWhat() As Variant)

On Error GoTo MakeUniqueCombinationOfSixError

Dim NCnt1 As Integer, NCnt2 As Integer, NCnt3 As Integer
Dim NCnt4 As Integer, NCnt5 As Integer, NCnt6 As Integer
Dim UpperBoundsOfArray As Integer, LowerBoundsOfArray As Integer
List1.Clear
UpperBoundsOfArray = UBound(AryOfWhat)
LowerBoundsOfArray = LBound(AryOfWhat)

For NCnt1 = LowerBoundsOfArray To UpperBoundsOfArray
  For NCnt2 = NCnt1 + 1 To UpperBoundsOfArray
    For NCnt3 = NCnt2 + 1 To UpperBoundsOfArray
      For NCnt4 = NCnt3 + 1 To UpperBoundsOfArray
        For NCnt5 = NCnt4 + 1 To UpperBoundsOfArray
          For NCnt6 = NCnt5 + 1 To UpperBoundsOfArray
            List1.AddItem AryOfWhat(NCnt1) & "," & AryOfWhat(NCnt2) & "," & _
                          AryOfWhat(NCnt3) & "," & AryOfWhat(NCnt4) & "," & _
                          AryOfWhat(NCnt5) & "," & AryOfWhat(NCnt6)
                          
               Text1.Text = List1.ListCount
                                    
                          
                          
          Next NCnt6
        Next NCnt5
      Next NCnt4
    Next NCnt3
  Next NCnt2
Next NCnt1






Exit Sub
MakeUniqueCombinationOfSixError:

MsgBox "MakeUniqueCombinationOfSix " & Err.Number & ":" & Err.Description

End Sub



Private Sub Form_Load()
Text5.Text = Date
        Randomize
        Dim A() As Variant
        A = Array(4, 6, 14, 18, 19, 20, 21, 24, 26, 27, 31, 32, 35, 36, 40, 41, 42, 47, 49)
        MakeUniqueCombinationOfSix A
End Sub