Erstellen Sie eine Liste der alle möglichen eindeutigen Kombinationen aus einem array (VBA)

Ich hatte eine ähnliche Anforderung vor einigen Jahren. Ich erinnere mich nicht warum und ich habe nicht mehr den code aber ich erinnere mich an den Algorithmus. Für mich war dies eine einmalige übung, damit wollte ich einen einfachen code. Ich kümmerte sich nicht um Effizienz.

Gehe ich davon aus ein-basierten arrays, da es macht für eine geringfügig einfachere Erklärung. Da die VBA unterstützt-basierten arrays, das sollte OK sein, obwohl es eine einfache Einstellung auf null-basierte arrays, wenn das ist, was Sie wollen.

AllFields(1-NumFields) hält den Namen.

Haben eine Schleife: Für Inx = 1-2^NumFields - 1

Innerhalb der Schleife prüfen, Inx, als eine binäre Zahl mit bits nummeriert von 1 bis NumFields. Für jedes N zwischen 1 und NumFields, wenn bit N eine include-AllFields(N) in dieser Kombination.

Diese Schleife erzeugt 2^NumFields - 1 Kombinationen:

Names: A B C

Inx:          001 010 011 100 101 110 111

CombinationS:   C  B   BC A   A C AB  ABC

Die einzige Schwierigkeit, mit VBA ist immer der Wert von Bit N.

Extra Abschnitt

Jeder an gehen bei der Umsetzung bits von meinem Algorithmus, dachte ich, ich hätte besser zeigen, wie ich es getan hätte.

Dann fülle ich ein array von test-Daten mit einem fiesen Satz von Feld-Namen, da haben wir nicht gesagt, welche Zeichen in einem Namen.

Unterprogramm GenerateCombinations macht das Geschäft. Ich bin ein fan von Rekursion, aber ich glaube nicht, dass mein Algorithmus ist kompliziert genug, um seine Verwendung zu rechtfertigen in diesem Fall. Ich kehre das Ergebnis in ein verzweigtes array, die ich lieber Verkettung. Die Ausgabe von GenerateCombinations ist die Ausgabe in das Direktfenster zu zeigen, Ihren Ausgang.

Option Explicit

Diese routine zeigt GenerateCombinations

Sub Test()

  Dim InxComb As Integer
  Dim InxResult As Integer
  Dim TestData() As Variant
  Dim Result() As Variant

  TestData = Array("A A", "B,B", "C|C", "D;D", "E:E", "F.F", "G/G")

  Call GenerateCombinations(TestData, Result)

  For InxResult = 0 To UBound(Result)
    Debug.Print Right("  " & InxResult + 1, 3) & " ";
    For InxComb = 0 To UBound(Result(InxResult))
      Debug.Print "[" & Result(InxResult)(InxComb) & "] ";
    Next
    Debug.Print
  Next

End Sub

GenerateCombinations macht das Geschäft.

Sub GenerateCombinations(ByRef AllFields() As Variant, _
                                             ByRef Result() As Variant)

  Dim InxResultCrnt As Integer
  Dim InxField As Integer
  Dim InxResult As Integer
  Dim I As Integer
  Dim NumFields As Integer
  Dim Powers() As Integer
  Dim ResultCrnt() As String

  NumFields = UBound(AllFields) - LBound(AllFields) + 1

  ReDim Result(0 To 2 ^ NumFields - 2)  ' one entry per combination 
  ReDim Powers(0 To NumFields - 1)          ' one entry per field name

  ' Generate powers used for extracting bits from InxResult
  For InxField = 0 To NumFields - 1
    Powers(InxField) = 2 ^ InxField
  Next

 For InxResult = 0 To 2 ^ NumFields - 2
    ' Size ResultCrnt to the max number of fields per combination
    ' Build this loop's combination in ResultCrnt
    ReDim ResultCrnt(0 To NumFields - 1)
    InxResultCrnt = -1
    For InxField = 0 To NumFields - 1
      If ((InxResult + 1) And Powers(InxField)) <> 0 Then
        ' This field required in this combination
        InxResultCrnt = InxResultCrnt + 1
        ResultCrnt(InxResultCrnt) = AllFields(InxField)
      End If
    Next
    ' Discard unused trailing entries
    ReDim Preserve ResultCrnt(0 To InxResultCrnt)
    ' Store this loop's combination in return array
    Result(InxResult) = ResultCrnt
  Next

End Sub

InformationsquelleAutor Tony Dallimore

bauen auf Thorstens Antwort:
(wo A = 4, B = 2, C = 1)

(der folgende pseudocode)

If (A And Inx <> 0) then
  A = True
end if

InformationsquelleAutor Harry