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

我不得不這樣做一次，最終適應this algorithm。它與嵌套循環有所不同，所以你可能會覺得它很有趣。轉換爲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