如果它们等于一个单元格，则获取所有组合的 vba 代码

Question

所以我有一个 15 列 x 100 行的数据表，其中包含所有不同的百分比，从 100%-0%，我希望从中获得所有可能的组合。现在我有一个可以将组合放入另外 15 列的代码。问题是，如何使代码仅输出加在一起 ​​= 100% 的组合。这是我现在拥有的代码。

Sub Perm()
  Dim rSets As Range, rOut As Range
  Dim vArr As Variant, lRow As Long

  Set rSets = Range("A1").CurrentRegion
  ReDim vArr(1 To rSets.Columns.Count)
  Set rOut = Cells(1, rSets.Columns.Count + 2)
  Perm1 rSets, vArr, rOut, 1, lRow
  End Sub

  Sub Perm1(rSets As Range, ByVal vArr As Variant, rOut As Range, ByVal lSetN As Long, lRow As Long)
  Dim j As Long

  For j = 1 To rSets.Rows.Count
      If rSets(j, lSetN) = "" Then Exit Sub
      vArr(lSetN) = rSets(j, lSetN)
      If lSetN = rSets.Columns.Count Then
          lRow = lRow + 1
          rOut(lRow).Resize(1, rSets.Columns.Count).Value = vArr
      Else
          Perm1 rSets, vArr, rOut, lSetN + 1, lRow
      End If
  Next j
  End Sub

Answer 1

我假设您的百分比是十进制值而不是文本（0.3 而不是 30%）。刚刚添加了一个 if 语句，求和的 vArr 并检查总和是否为 1。

  Sub Perm1(rSets As Range, ByVal vArr As Variant, rOut As Range, ByVal lSetN As Long, lRow As Long)
  Dim j As Long

  For j = 1 To rSets.Rows.Count
      If rSets(j, lSetN) = "" Then Exit Sub
      vArr(lSetN) = rSets(j, lSetN)
      If lSetN = rSets.Columns.Count Then
          If WorksheetFunction.Sum(vArr) = 1 Then
              lRow = lRow + 1
              rOut(lRow).Resize(1, rSets.Columns.Count).Value = vArr
          End If
      Else
          Perm1 rSets, vArr, rOut, lSetN + 1, lRow
      End If
  Next j