Как мне сократить этот кусок кода, чтобы напечатать каждую возможную комбинацию (учитывая определенные параметры)

Question

Я хотел бы перечислить все комбинации из 9 различных переменных.

Каждая переменная хранится в 9 различных столбцах.

Каждая переменная имеет разные верхние пределы.

Есть ли более простой способ написать этот код?

Каждая переменная должна быть четным числом.

Любая переменная "Rest___" идет от 8-20 (например, 8,10, ... 18,20)

Любая переменная "Work___" идет от 8-12 (например, 8,10,12)

Dim i As Long
Dim j As Long
Dim Rest1 As Integer
Dim Rest2 As Integer
Dim Rest3 As Integer
Dim Rest4 As Integer

Dim Work1 As Integer
Dim Work2 As Integer
Dim Work3 As Integer
Dim Work4 As Integer
Dim Work5 As Integer

Dim TableRange As Range
'I know the range should have at least 583,443 rows 583,443
Set TableRange = Range("b3:t1000")

i=1
j=1

For Rest1 = 8 To 20 Step 2
    For Rest2 = 8 To 20 Step 2
        For Rest3 = 8 To 20 Step 2
            For Rest4 = 8 To 20 Step 2
                    For Work1 = 8 To 12 Step 2
                        For Work2 = 8 To 12 Step 2
                            For Work3 = 8 To 12 Step 2
                                For Work4 = 8 To 12 Step 2
                                    For Work5 = 8 To 12 Step 2
                                        TableRange(i, j) = Rest1
                                        j = j + 1
                                        TableRange(i, j) = Rest2
                                        j = j + 1
                                        TableRange(i, j) = Rest3
                                        j = j + 1
                                        TableRange(i, j) = Rest4
                                        j = j + 1
                                        TableRange(i, j) = Work1
                                        j = j + 1
                                        TableRange(i, j) = Work2
                                        j = j + 1
                                        TableRange(i, j) = Work3
                                        j = j + 1
                                        TableRange(i, j) = Work4
                                        j = j + 1
                                        TableRange(i, j) = Work5
                                        j = 1
                                        i = i + 1
                                    Next Work5
                                Next Work4
                            Next Work3
                        Next Work2
                    Next Work1
            Next Rest4
        Next Rest3
    Next Rest2
Next Rest1

Как мой код, Excel выдает«Ошибка времени выполнения» 6 «Переполнение»

Я включил изображение того, как должен выглядеть вывод: SampleOutput

Answer 1

Это моя реализация смешанной базы. Выходные данные выглядят как ваши, кроме заголовков - их нужно добавить.

Итак, представьте счетчик, который выглядит следующим образом - каждая цифра сбрасывается в ноль, когда достигает числа уровней в каждой из ваших переменных:

000000000
000000001
000000002
000000010
000000011

и т. Д.

Это соответствует первым строкам вашей таблицы

8  8  8  8  8  8  8  8  8
8  8  8  8  8  8  8  8 10
8  8  8  8  8  8  8  8 12
8  8  8  8  8  8  8 10  8
8  8  8  8  8  8  8 10 10

---

Option Explicit

Sub Combinations()

'Set up arrays to define number of levels in each variable and to hold counter.

Dim nValues, startValues, countArray As Variant
nValues = Array(3, 3, 3, 3, 3, 7, 7, 7, 7)
countArray = Array(0, 0, 0, 0, 0, 0, 0, 0, 0)

'Define constants
Const startValue = 8, increment = 2, nCols = 9

'Define variables
Dim row As Long
Dim column, carry As Integer

'Work out number of rows and define an array to hold results

Dim nRows As Variant
nRows = WorksheetFunction.Product(nValues)

Dim holdingArray() As Integer
ReDim holdingArray(nRows, nCols)

'Loop over rows

For row = 0 To nRows - 1
    carry = 0

' Loop over columns

    For column = 0 To nCols - 1
        countArray(column) = countArray(column) + carry

        'Check if a 'carry' is needed

        If countArray(column) = nValues(column) Then
            carry = 1
            countArray(column) = 0
        Else
            carry = 0
        End If

        'Store results (reverse order of columns)

        holdingArray(row, nCols - 1 - column) = startValue + countArray(column) * increment
    Next column

'Increment counter

countArray(0) = countArray(0) + 1
Next row

'Transfer array to sheet

Range(Cells(1, 1), Cells(nRows, nCols)) = holdingArray


End Sub

РЕДАКТИРОВАТЬ

Хотя первоначальный ответ дает правильный результат, он лучше работает, если массивы начинаются с 1 (поэтому база вариантов 1). Также я сделал ошибку новичка, думая, что вы можете определить несколько переменных одинакового типа в одном выражении Dim без повторения типа.

Версия 2:

Option Explicit
Option Base 1

Sub Combinations()

'Define constants
Const startValue = 8, increment = 2

'Define variables
Dim row As Long, nRows As Long
Dim column As Integer, carry As Integer, nCols As Integer

'Set up arrays to define number of levels in each variable and to hold counter.

Dim nValues As Variant, countArray As Variant
nValues = Array(3, 3, 3, 3, 3, 7, 7, 7, 7)

nCols = UBound(nValues)
ReDim countArray(nCols)

Debug.Print ("ubound=" & UBound(nValues))

'Work out number of rows and define an array to hold results

nRows = WorksheetFunction.Product(nValues)

Debug.Print ("nrows=" & nRows)

Dim holdingArray() As Integer
ReDim holdingArray(nRows, nCols)

'Loop over rows

For row = 1 To nRows
    carry = 0

' Loop over columns

    For column = 1 To nCols
        countArray(column) = countArray(column) + carry

        'Check if a 'carry' is needed

        If countArray(column) = nValues(column) Then
            carry = 1
            countArray(column) = 0
        Else
            carry = 0
        End If

        'Store results (reverse order of columns)

        holdingArray(row, nCols + 1 - column) = startValue + countArray(column) * increment
    Next column

'Increment counter

countArray(1) = countArray(1) + 1
Next row

'Transfer array to sheet

Range(Cells(1, 1), Cells(nRows, nCols)) = holdingArray


End Sub