从 VBA 中的多个数组创建所有参数组合

Question

我有一组参数。每个参数都有一个可能值列表，这个可能值列表由最小值、最大值和步长值标识。

我有很多参数都有自己的一组值。 上面的简化示例表明：

• 参数 1 将采用可能的值 8、10、12
• 参数 2 将采用可能的值 1200、1800、2400
• 参数 3 将采用可能的值 60、75、90、105

输入参数表的行数应该是动态的，因为参数的数量和可能的值可能会演变。

我的目标是创建一个包含这些数组所有可能组合的表（未排序，我确实想要所有排列）。预期的输出表如下所示。

我希望对参数的动态数量和动态参数值实现相同的效果。

到目前为止，我已经设法阅读了参数表以制作我想要组合的所有值的数组，但我正在努力找出如何循环遍历数组以组合所有值。

我的代码现在看起来像这样，其中输入“ParametersTest”是上面显示的表格：

Dim myParametersTable As ListObject
Dim myArray As Variant
Dim myTmpArray As Variant
Dim inputArray As Variant
Dim outputArray As Variant
Dim printArray As Variant
Dim x As Long
Dim Param_ID As String
Dim Min As Double
Dim Max As Double
Dim Step As Double
Dim Size As Long
Dim OSize As Long


'Set path for Table variable
  Set myParametersTable = ActiveSheet.ListObjects("ParametersTest")


' Input array is first dimension as a list of parameters
ReDim inputArray(myParametersTable.ListRows.Count)

'Loop Through Every Row in Table and create 2nd dimension array with a list of values for each parameter
OSize = 1
  For x = 1 To myParametersTable.ListRows.Count
    Param_ID = myParametersTable.DataBodyRange(x, 1)
    Min = myParametersTable.DataBodyRange(x, 3)
    Max = myParametersTable.DataBodyRange(x, 4)
    Step = myParametersTable.DataBodyRange(x, 5)
    'Debug.Print (Step)

    If Step = 0 Then
        Size = 1
    Else
        Size = (Max - Min) / Step + 1
    End If
        
    OSize = OSize * Size
    printArray = Array(Size, OSize)
    'Debug.Print Join(printArray, ";")
    
    ReDim myTmpArray(Size)
    For y = 1 To Size
        myTmpArray(y - 1) = Min + Step * (y - 1)
    Next y
    'Debug.Print Join(myTmpArray, ";")
  
    ' Populate the 1st dimension of the input array
    inputArray(x - 1) = myTmpArray
    
  Next x
 
 
ReDim outputArray(OSize)
ReDim myTmpArray(myParametersTable.ListRows.Count)
  
  For x = LBound(inputArray) To UBound(inputArray) - 1
  Debug.Print (UBound(inputArray(x)) - 1)
    For y = LBound(inputArray(x)) To UBound(inputArray(x)) - 1
        Debug.Print (inputArray(x)(y))
    Next y
  Next x

End Sub ```


 


  [1]: https://i.stack.imgur.com/szAco.png
  [2]: https://i.stack.imgur.com/8qXpG.png

Answer 1

我修改了这个以适合您的数组（用于 excel VBA）。它被评论了。

Option Explicit

Dim irow&, aall, acombination

Sub sub1() ' combinations
  Dim a1, a2, a3 ' variants
  a1 = Array(8, 10, 12)
  a2 = Array(1200, 1800, 2400)
  a3 = Array(60, 75, 90, 105)
  aall = Array(a1, a2, a3) ' array of arrays
  acombination = Array(0, 0, 0) ' one combination
  irow = 1
  Call docombinations(0) ' start it off
End Sub

Sub docombinations(ia) ' recursive
  Dim i&
  For i = 0 To UBound(aall(ia)) ' for each item
    acombination(ia) = aall(ia)(i) ' add this item
    If ia = UBound(aall) Then ' at end, print
      Call printcombination
    Else                      ' else go on to next
      Call docombinations(ia + 1)
    End If
  Next i
End Sub

Sub printcombination() ' output one combination
  Dim i&
  For i = 0 To UBound(acombination)
    Cells(irow, i + 1) = acombination(i)
  Next
  irow = irow + 1
End Sub