Sub Wertekombinationen_ausgeben(filename As String, _
      values() As Integer, kstart%, kend%)
 
      'Filename: Ausgabedatei für Kombinationen
      'values: Array mit den zu kombinierenden Werten
      'kstart: kleinste Kombination (mindestens 1)
      'kend: größte Kombination (maximal ubound(values)+1)
 
      Dim ak%, i%: ak = FreeFile
      If kend > UBound(values) + 1 Then kend = UBound(values) + 1
 
      Open filename For Append As #ak
      For i = kstart To kend
         NueberK_Output values, i, ak
      Next i
      Close #ak
   End Sub
 
 
   Sub NextIndex(ByRef indices() As Integer, n%)
 
        'Ermittlung der nächsten Indizierung bei
        'Kombinationen ohne Zurücklegen
 
        Dim j%, k%, l%, m%
        k = UBound(indices) + 1
 
        If indices(0) = -1 Then
            'Startwerte erstellen
            For j = 0 To k - 1
                indices(j) = j
            Next j
            Exit Sub
        End If
 
        m = -1
        For j = k - 1 To 0 Step -1
            m = m + 1
            If indices(j) < n - 1 - m Then
                indices(j) = indices(j) + 1
                For l = j + 1 To k - 1
                    indices(l) = indices(l - 1) + 1
                Next
                Exit For
            End If
        Next j
 
     End Sub
 
 
    Function NueberK(n%, k%) As Double
 
        'Binomialkoeffizient berechnen
        NueberK = -1
        If k < 1 Then Exit Function
        If n < k Then Exit Function
 
        Dim j%
        Dim zw#: zw = 1
        Dim nw#: nw = 1
        For j% = 0 To k - 1
            zw = zw * (n - j): nw = nw * (j + 1)
        Next j
 
        NueberK = zw / nw
 
    End Function
 
 
    Function NueberK_Output(values() As Integer, k%, _
        kanal_out As Integer) As Boolean
 
        'Liste aller Kombinationen der Werte in Values
 
        'values: null-basiertes Array mit Werteliste n = ubound(values)+1)
        'k: Anzahl der Werte in einer Kombination
        'Ausgabe in den Output_kanal
 
        On Error GoTo fehler
        NueberK_Output = False
 
        Dim indices%()
        ReDim indices%(k - 1)
        indices(0) = -1
 
        Dim anz&
        anz = CLng(NueberK(UBound(values) + 1, k))
        If anz = -1 Then Exit Function
 
        Dim i&, j%
        For i = 1 To anz
            NextIndex indices, UBound(values) + 1
            For j = 0 To k - 1
               Print #kanal_out, values(indices(j));
            Next j
            Print #kanal_out, ""
        Next i
 
        NueberK_Output = True
        Exit Function
 
fehler:
 
    End Function