Распечатать перестановки с условием - VB

Формулировка задачи:

Даны цифры 1 2 3 4 5 6. Требуется распечатать все перестановки из этих цифр с условием, что 1) 1 стоит левее 2 2) 3 стоит левее 4 3) 5 стоит левее 6 Всего таких перестановок 90 штук. Чтобы был понятно приведу пример попроще для цифр 1 2 3 4 (условия те же) 1 2 3 4 1 3 2 4 1 3 4 2 3 1 2 4 3 1 4 2 3 4 1 2 (тут других вариантов нет) решение Ну очевидно, что на первом месте могут стоять цифры 1 3 5 а на последнем 2 4 6. А вот дальше видимо не обойтись без прямой проверки всех цифр. Может есть код попроще? Буду рад любой подсказке...

Решение задачи: «Распечатать перестановки с условием»

textual
                            Листинг программы 
                        
 
                            
                        
Private prmArr() As Long
 
Sub main()
    Dim n As Long, i As Long, k As Long
    n = 6
    ReDim prmArr(1 To n) As Long, a(1 To n) As Long
    For i = 1 To n
        prmArr(i) = i + i Mod 2 - 1
    Next i
 
    Do
        k = k + 1
        ReDim b(1 To n) As Long
        Debug.Print k,
        For i = 1 To n
            a(i) = prmArr(i) + b(prmArr(i))
            b(prmArr(i)) = b(prmArr(i)) + 1
            Debug.Print a(i);
        Next i
        Debug.Print
    Loop While MyNarayanaNextPerm(n)
 
End Sub
 
Function MyNarayanaNextPerm(n As Long) As Long
    Dim i As Long, k As Long, t As Long, tmp As Long
    
    For k = n - 1 To 1 Step -1
        If prmArr(k) < prmArr(k + 1) Then Exit For
    Next k
        
    If k Then
        t = n
        While t > k And prmArr(k) >= prmArr(t)
            t = t - 1
        Wend
        tmp = prmArr(k): prmArr(k) = prmArr(t): prmArr(t) = tmp
        t = n
        For i = k + 1 To (n + k) \ 2
            tmp = prmArr(i): prmArr(i) = prmArr(t): prmArr(t) = tmp
            t = t - 1
        Next i
        MyNarayanaNextPerm = i
    End If
End Function