Перестановки в VBA

Question

Я пытаюсь создать макрос, который выводит все возможные перестановки, начиная со столбца из нескольких чисел, где каждое последовательное число не может быть больше числа над ним.

Итак, я хотел бы сделать, чтобы предоставить Excel столбец из 15 значений в Sheet1 в диапазоне от 1 до 9. Значения должны быть в порядке убывания, чтобы число в строке ниже никогда не превышало значение выше.

То, что я пытаюсь сделать, это вывести новые перестановки этого списка, по одному новому листу на каждый список.

Будет указан верхний предел значений в списке, чтобы число перестановок составляло все, что находится между начальным списком и значением верхнего предела.

Существует условие, которое я не могу нарушить, и это то, что значение строки ниже другой строки не может иметь большее значение, чем значение выше. Есть изображение, которое немного объясняет.

Пока мой код даже не на полпути, и я чувствую себя полностью потерянным. Я даже не уверен, как думать об этой проблеме, не говоря уже о ее кодировании. Любой вклад будет принята с благодарностью.

Sub

    doSomeStuff()

    Dim maxNotch, startNotch, Counter As Integer
    Dim shit As Range

    maxNotch = 3
    startNotch = ThisWorkbook.Sheets("Sheet1").Cells(2, 2)


    Counter = startNotch
    sheetnumber = 2
    For j = st

    artNotch To maxNotch

    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = "Sheet" & sheetnumber

        ThisWorkbook.Sheets("Sheet" & sheetnumber).Cells(2, 2).Value = Counter
    For i = 1 To 3

        ThisWorkbook.Sheets("Sheet" & sheetnumber).Cells(i + 1, 1).Value = 2 + i

        If ThisWorkbook.Sheets("Sheet" & sheetnumber).Cells(i + 1, 2).Value <> Counter Then
           k = Counter - ThisWorkbook.Sheets("Sheet" & sheetnumber - 1).Cells(i + 1, 2).Value
           Debug.Print k
        End If

    Next i


    sheetnumber = sheetnumber + 1
    Counter = Counter + 1
    Next j

    Application.DisplayAlerts = True
End Sub


Function pop()

    (ByVal j As Integer, k As Integer)
    For i = 1 To 3

        ThisWorkbook.Sheets("Sheet" & j + 1).Cells(i + 1, 1).Value = 2 + i
        ThisWorkbook.Sheets("Sheet" & j + 1).Cells(2, 2).Value = Counter


        If ThisWorkbook.Sheets("Sheet" & j + 1).Cells(i + 1, 2).Value <> Cou

    nter Then
            ThisWorkbook.Sheets("Sheet" & j + 1).Cells(i + 1, 2).Value = ThisWorkbook.Sheets("Sheet" & j).Cells(i + 1, 2).Value
        End If
    Next i

End Function

Answer 1

Пример из моего комментария для учета заказа:

dim pc as long, ws as worksheet
for each ws in worksheets
    with ws
        If ws.name <> "sourcedatasheet" then
            .cells(2,2).resize(pc).value = "" 'export your list; pc = permutation count
            .Range(.Cells(1,2),.Cells(pc+1,2)).Sort key1:=.Cells(1,2), order1:=xlDescending, Header:=xlYes 'used a header because row 1 is blank
        end if
    end with
next

---

Edit1:

Добавление оператора if для учета некоторых конкретныхлист не включается