vba Excel VBA中的组合算法

Combination Algorithm in Excel VBA

提问by js0823

I need an algorithm which generates all possible combination of a set number and output all of them onto Excel spreadsheet.

我需要一种算法来生成一组数字的所有可能组合并将它们全部输出到 Excel 电子表格中。

For example, with n = 5(1,2,3,4,5) and r = 2(created a small gui for this), it will generate all possible combinations and output them into excel spreadsheet like this...

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

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

The order in which it prints doesn't matter. It can first print (5,1), then (1,2). Can anyone show me how to do this?

它的打印顺序无关紧要。它可以先打印 (5,1)，然后是 (1,2)。谁能告诉我如何做到这一点？

Thank you very much.

非常感谢。

回答by adamleerich

How about this code...

这段代码怎么样...

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

回答by Joubarc

I had to do this once and ended up adapting this algorithm. It's somewhat different from nested loops, so you may find it interesting. Translated to VB, this would be something like this:

我不得不这样做一次并最终调整了这个算法。它与嵌套循环有些不同，因此您可能会觉得它很有趣。转换为 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

回答by Vityata

These combination algorithms are best made with nested loops with recursion. I have wrote some 4 years ago the exactly needed code to carry this out (https://vitoshacademy.com/vba-nested-loops-with-recursion). The idea is to change the sizevariable in the Mainand the input array in the same Sub. Then run it:

这些组合算法最好使用带有递归的嵌套循环。我在大约 4 年前编写了执行此操作所需的代码（https://vitoshacademy.com/vba-nested-loops-with-recursion）。这个想法是改变同一个Sub中的size变量Main和输入数组。然后运行它：

Sub Main()

    Static size         As Long
    Static c            As Variant
    Static arr          As Variant
    Static n            As Long

    size = 2
    c = Array(1, 2, 3, 4, 5, 6)

    n = UBound(c) + 1
    ReDim arr(size - 1)

    EmbeddedLoops 0, size, c, n, arr

End Sub

Function EmbeddedLoops(index, k, c, n, arr)

    Dim i                   As Variant

    If index >= k Then
        PrintArrayOnSingleLine arr
    Else
        For Each i In c
            arr(index) = i
            EmbeddedLoops index + 1, k, c, n, arr
        Next i
    End If

End Function

The debug.printhas built-in limit in VBA, displaying only the last 200 values in the Immediate Window (Ctrl+G). Thus, if you have more than 200 lines of results, it is better to write to Excel spreadsheet, to a txt.file or to a database:

在debug.print已经内置限制在VBA中，只显示在立即窗口（最后200个值Ctrl+ G）。因此，如果您有超过 200 行的结果，最好写入 Excel 电子表格、txt.file 或数据库：

Public Sub PrintArrayOnSingleLine(myArray As Variant)

    Dim counter     As Integer
    Dim textArray     As String

    For counter = LBound(myArray) To UBound(myArray)
        textArray = textArray & myArray(counter)
    Next counter

    Debug.Print textArray

End Sub