Комбинированный алгоритм в Excel VBA - PullRequest
Новая
       16

Комбинированный алгоритм в Excel VBA

4 голосов
/ 26 августа 2011

Мне нужен алгоритм, который генерирует все возможные комбинации заданного числа и выводит их все в электронную таблицу Excel.

Например, при n = 5 (1,2,3,4,5) иr = 2 (для этого создал небольшой графический интерфейс), он сгенерирует все возможные комбинации и выведет их в электронную таблицу Excel следующим образом ... 

1,2
1,3
1,4
...

Порядок, в котором он печатается, не имеет значения.Сначала можно вывести (5,1), затем (1,2).Может кто-нибудь показать мне, как это сделать?

Большое спасибо.

Ответы [ 2 ]

8 голосов
/ 26 августа 2011

Я должен был сделать это один раз и в итоге адаптировал этот алгоритм .Это несколько отличается от вложенных циклов, так что вы можете найти это интересным.В переводе на VB это будет примерно так: 

Public Sub printCombinations(ByRef pool() As Integer, ByVal r As Integer)
    Dim n As Integer
    n = UBound(pool) - LBound(pool) + 1

   ' Please do add error handling for when r>n

    Dim idx() As Integer
    ReDim idx(1 To r)
    For i = 1 To r
        idx(i) = i
    Next i

    Do
        'Write current combination
        For j = 1 To r
            Debug.Print pool(idx(j));
            'or whatever you want to do with the numbers
        Next j
        Debug.Print

        ' Locate last non-max index
        i = r
        While (idx(i) = n - r + i)
            i = i - 1
            If i = 0 Then
                'All indexes have reached their max, so we're done
                Exit Sub
            End If
        Wend

        'Increase it and populate the following indexes accordingly
        idx(i) = idx(i) + 1
        For j = i + 1 To r
            idx(j) = idx(i) + j - i
        Next j
    Loop
End Sub
8 голосов
/ 26 августа 2011

Как насчет этого кода ... 

Option Explicit

Private c As Integer

Sub test_print_nCr()
  print_nCr 5, 3, Range("A1")
End Sub

Function print_nCr(n As Integer, r As Integer, p As Range)
  c = 1
  internal_print_nCr n, r, p, 1, 1
End Function


Private Function internal_print_nCr(n As Integer, r As Integer, ByVal p As Range, Optional i As Integer, Optional l As Integer) As Integer

  ' n is the number of items we are choosing from
  ' r is the number of items to choose
  ' p is the upper corner of the output range
  ' i is the minimum item we are allowed to pick
  ' l is how many levels we are in to the choosing
  ' c is the complete set we are working on

  If n < 1 Or r > n Or r < 0 Then Err.Raise 1
  If i < 1 Then i = 1
  If l < 1 Then l = 1
  If c < 1 Then c = 1
  If r = 0 then 
    p = 1
    Exit Function
  End If

  Dim x As Integer
  Dim y As Integer

  For x = i To n - r + 1
    If r = 1 Then
      If c > 1 Then
        For y = 0 To l - 2
          If p.Offset(c - 1, y) = "" Then p.Offset(c - 1, y) = p.Offset(c - 2, y)
        Next
      End If
      p.Offset(c - 1, l - 1) = x
      c = c + 1
    Else
      p.Offset(c - 1, l - 1) = x
      internal_print_nCr n, r - 1, p, x + 1, l + 1
    End If
  Next

End Function
...