код VBA, чтобы получить все комбинации, если они равны ячейке - PullRequest
Новая
       10

код VBA, чтобы получить все комбинации, если они равны ячейке

0 голосов
/ 04 сентября 2018

Итак, у меня есть 15-рядный столбец данных с разным процентом, от 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

1 Ответ

0 голосов
/ 04 сентября 2018

Я предположил, что ваши проценты были десятичными значениями, а не текстом (.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
...