获取所有组合

如果我理解正确，那么我将称呼您的“集合”维度以及这些维度中您可能组合的地址。例如，在x和y的两个维中，其中x的长度为2，y的长度为3，如果x和y的元素为N，则有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