Kombination-Algorithmus in Excel-VBA

Brauche ich einen Algorithmus generiert alle möglichen Kombinationen einer bestimmten Anzahl und Ausgang Sie auf Excel-Kalkulationstabelle.

Beispielsweise mit n = 5(1,2,3,4,5) und r = 2(erstellt eine kleine gui dafür), wird es erzeugt alle möglichen Kombinationen sowie deren Ausgabe in excel-Tabelle...

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

Die Reihenfolge, in der Sie druckt, spielt keine Rolle. Es kann der erste print (5,1), dann ist (1,2).
Kann jemand mir zeigen, wie dies zu tun?

Danke Ihnen sehr.

Ist die Reihenfolge wichtig? Ist 5,1 die gleiche wie 1,5 ?
Wenn die Bestellung (als Tim ihn gefragt) wichtig ist, dann "alle möglichen Kombinationen" kann schnell wachsen. Wenn n und r sind beide 8, Fakultät 8, oder über 40.000 Permutationen. Haben Sie einen Grenzwert für n Sinn?
Ja die Reihenfolge ist wichtig. Sorry für die nicht setzen, dass in. 1,5 ist die gleiche wie 5,1.
Nein habe ich nicht Grenzen für n oder r ist. Ich möchte es dynamisch sein, damit jeder Benutzer kann in beliebiger Anzahl und es generiert die Tabelle mit allen möglichen Kombinationen.
Kann nicht glauben, niemand hat Sie gebeten, dieses eine noch: Haben Sie versucht, etwas selbst? Die Antwort ist im Grunde aus zwei Ineinander For Next Schleifen.

InformationsquelleAutor js0823 | 2011-08-25

  1. 8

    Wie über diesen 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
    Danke! Nun muss ich nur herausfinden, wie man drucken Sie dann auf Zellen jeder. Ich bin neu in VBA, so habe ich lernen für die letzten 2 Tage.

    InformationsquelleAutor adamleerich

  2. 8

    Ich hatte dies einmal und landete Anpassung dieser Algorithmus. Es ' s etwas anders aus verschachtelten Schleifen, so finden Sie es vielleicht interessant. Übersetzt auf VB, das wäre so etwas wie dieses:

    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
    Danke. Ich versuchte es und es funktioniert gut, aber die array-Eingabe in der Excel-Tabelle war nicht das, was ich suchte. Aber ich versuchte es und es funktioniert perfekt für jemand anderen, vielleicht brauchen diese.
    Das ist, warum ich sagen, "sowas" 🙂

    InformationsquelleAutor Joubarc

Schreibe einen Kommentar