Excel 如何缩短这段代码以打印每个可能的组合（给定某些参数）

我想列出9个不同变量的所有组合

每个变量存储在9个不同的列中

每个变量都有不同的上限

有没有更简单的方法来编写此代码

每个变量必须是偶数

任何“Rest_______________________________________

任何“工时”变量的取值范围为8-12（例如8,10,12）

正如我的代码一样，Excel抛出“运行时错误'6'溢出”

我已经包括了输出应该是什么样子的图片：

---

这是我对混合基的实现。除了标题外，输出看起来与您的类似-需要添加这些标题

想象一个计数器是这样的——当它达到每个变量中的级别数时，每个数字都重置为零：

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

---

编辑

虽然原始答案确实给出了正确的结果，但如果数组从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

---

您正在使用整数数据类型。改为long@JvdV-使用“长”是否会提高效率？我认为将其保持为整数将使用更少的内存（特别是因为我的变量最多只能从8到20）@Cyril-我有9个变量，所以我尝试获得所有不同的组合（例如，剩余1可以从8到20，剩余2可以从8到20…工作1可以从8到12，工作2可以从8到12）@newtovba-请参阅为什么要使用long.Note-使用它可以更快地构建数组，然后一次性写入工作表。这太棒了。我尝试了一种混合基，使用列计数器，并在应该重置时将列计数器递减为信号，但我喜欢这种代码的简单性。非常感谢！我尝试添加另一个需要计数的变量（只需要8,10），但当我尝试更改：nValues=Array（2,3,3,3,3,7,7）countArray=Array（0,0,0,0,0,0,0）Const startValue=8，increment=2，nCols=10时，我在尝试打印数组时遇到运行时错误“1004”。我做错了什么？没有做错任何事情，但是如果你计算出行数，现在是1166886，这超过了一张表中允许的最大行数！再次拯救这一天。有道理。再次感谢：）

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

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