Excel VBA中的组合算法

Question

我需要一种算法,它可以生成所有可能的组号组合,并将所有这些组合输出到Excel电子表格中.

例如,当n = 5(1,2,3,4,5)和r = 2(为此创建一个小gui)时,它将生成所有可能的组合并将它们输出到这样的excel电子表格中......

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

它打印的顺序无关紧要.它可以先打印(5,1),然后打印(1,2).谁能告诉我怎么做？

非常感谢你.

Answer 1

这段代码怎么样......

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

Answer 2

我不得不这样做一次,最后调整了这个算法.它与嵌套循环有些不同,所以你可能会发现它很有趣.转换为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