获取所有组合

我想要生成所有可能的向量，其中每个元素的最小值和最大值是已知的，而一些元素只能具有相同的值。

例如，我有这样的input：

rid Set MaxId 1 a 1 2 b 2 3 c 2 4 c 2 5 c 2 

设置标识所有应始终具有相同值的元素， MaxId标识最大整数属性可具有的值，最小值始终为1.从这些数据中，我们可以创build以下4个组合（表示为c1 – c4 ）：

 rid Set c1 c2 c3 c4 1 a 1 1 1 1 2 b 1 1 2 2 3 c 1 2 1 2 4 c 1 2 1 2 5 c 1 2 1 2 

我怎样才能使用VBA做到这一点？ 在我的真实数据中，我有100行5个不同的集合，导致总共80个variables，其中最大Id在1到5之间。

上面的例子是完整的，没有额外的input提供。 我们来看一个不同的例子：

 rid Set MaxId 1 a 2 2 b 1 3 c 3 4 c 3 5 c 3 

这将导致6种可能的组合（ 2 x 1 x 3 ）。 只有一个3因为这个数字是我称之为“一套”，由相同的字母c确定的一部分。 可能的组合是：

 rid Set c1 c2 c3 c4 c5 c6 1 a 1 2 1 1 2 2 2 b 1 1 1 1 1 1 3 c 1 1 2 3 2 3 4 c 1 1 2 3 2 3 5 c 1 1 2 3 2 3 

Answer 1

如果我理解正确的话，那么我会在这些维度中调用你的“集合”维度和你的组合可能的地址。 例如，在x和y两个维度中，x的长度为2，y的长度为3，如果x的x和y元素有6个可能的点（x，y）。在x，y和z的三个维度中，x是长度2，y长度为3，z长度为2，如果N的x，y和z元素有12个可能的点（x，y，z）

为了遍历维度中的所有地址，通常使用嵌套循环。 所以我也会在这里做。

 Sub Dimensions() With ThisWorkbook.Worksheets(1) 'create a dictionary for up to 5 different dimensions named "a" to "e" 'and their max length values 'using dictionary because mapping key (dimension name) to value (max length value) Set dDimensions = CreateObject("Scripting.Dictionary") dDimensions.Add "a", 9999 '9999 is the stop value which shows that this Dimension is not used dDimensions.Add "b", 9999 dDimensions.Add "c", 9999 dDimensions.Add "d", 9999 dDimensions.Add "e", 9999 'get the dimension definitions from A2:B[n] r = 2 Do While .Cells(r, 1) <> "" sDimension = .Cells(r, 1).Value lMax = .Cells(r, 2).Value If lMax > 0 And dDimensions.exists(sDimension) Then 'if inconsistent definitions for length of dimensions exists, 'for example "a" with max length 3 and "a" with max length 2, 'then take the lowest max length definition, in example "a" with 2 If dDimensions.Item(sDimension) > lMax Then dDimensions.Item(sDimension) = lMax End If r = r + 1 Loop 'calculate the count of possible combinations lCount = 1 For Each sDimension In dDimensions lMax = dDimensions.Item(sDimension) If lMax < 9999 Then lCount = lCount * lMax Next 'create a dictionary for the results 'up to 5 different Dimensions named "a" to "e" 'and their possible values in lCount possible combinations Set dResults = CreateObject("Scripting.Dictionary") Dim aPointAddresses() As Long ReDim aPointAddresses(lCount - 1) dResults.Add "a", aPointAddresses dResults.Add "b", aPointAddresses dResults.Add "c", aPointAddresses dResults.Add "d", aPointAddresses dResults.Add "e", aPointAddresses 'go through all possible addresses and fill the dResults lCount = 0 For a = 1 To dDimensions.Item("a") For b = 1 To dDimensions.Item("b") For c = 1 To dDimensions.Item("c") For d = 1 To dDimensions.Item("d") For e = 1 To dDimensions.Item("e") If dDimensions.Item("a") < 9999 Then arr = dResults.Item("a") arr(lCount) = a dResults.Item("a") = arr End If If dDimensions.Item("b") < 9999 Then arr = dResults.Item("b") arr(lCount) = b dResults.Item("b") = arr End If If dDimensions.Item("c") < 9999 Then arr = dResults.Item("c") arr(lCount) = c dResults.Item("c") = arr End If If dDimensions.Item("d") < 9999 Then arr = dResults.Item("d") arr(lCount) = d dResults.Item("d") = arr End If If dDimensions.Item("e") < 9999 Then arr = dResults.Item("e") arr(lCount) = e dResults.Item("e") = arr End If lCount = lCount + 1 If dDimensions.Item("e") = 9999 Then Exit For Next If dDimensions.Item("d") = 9999 Then Exit For Next If dDimensions.Item("c") = 9999 Then Exit For Next If dDimensions.Item("b") = 9999 Then Exit For Next If dDimensions.Item("a") = 9999 Then Exit For Next 'now dResults contains an array of possible point addresses for each used dimension 'key:="dimension", item:={p1Addr, p2Addr, p3Addr, ..., pNAddr} 'clear the result range .Range("D:XFD").Clear 'print out the results in columns D:XFD .Range("D1").Value = "p1" .Range("D1").AutoFill Destination:=.Range("D1:XFD1") r = 2 Do While .Cells(r, 1) <> "" sDimension = .Cells(r, 1).Value arr = dResults.Item(sDimension) .Range(.Cells(r, 4), .Cells(r, 4 + UBound(arr))).Value = arr r = r + 1 Loop End With End Sub