Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
932to936
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
932to936
932to936
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

kombinationen aus bestimmten zahlen

kombinationen aus bestimmten zahlen
06.12.2007 23:35:35
yusuf
hallo zusammen,
es tut mir leid das ich den beitrag hier nochmal reinsetze, aber trotz und nur mit daniels hilfe haben wir es geschafft den code so weit zu bringen. es ging darum, das ich dreier oder sechser kombinationen aus selbst 20 ausgesuchten zahlen berechnen lassen wollte.
das problem liegt daran das der code, warum auch immer einen laufzeitfehler hat. Zusätzlich rechnet es alle möglichen kombinationen aus (auch wiederholungen) was auf gar keinen fall sein darf.
z.B.:
wenn die erste kombination 1,2,3,4,5,6 ist dann dürfen diese zahlen egal in welcher reihenfolge nicht mehr vorkommen (2,1,3,4,5,6 oder 3,1,2,4,5,6)
hier der code

Sub test()
Dim Zahlen
Dim Anz As Long
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim Zeile As Long
Dim Erg
Anz = Range("Anz")
ReDim Erg(Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5))
Zahlen = Range("Zahlenliste").Resize(Anz, 1)
Zeile = 0
Range("C:H").ClearContents
For i = 1 To Anz
Application.StatusBar = "Bearbeitet: " & Format(i / Anz, "0%")
For j = 1 To Anz
For k = 1 To Anz
For l = 1 To Anz
For m = 1 To Anz
For n = 1 To Anz
If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then
Zeile = Zeile + 1
Erg(Zeile, 1) = Zahlen(i, 1)
Erg(Zeile, 2) = Zahlen(j, 1)
Erg(Zeile, 3) = Zahlen(k, 1)
Erg(Zeile, 4) = Zahlen(l, 1)
Erg(Zeile, 5) = Zahlen(m, 1)
Erg(Zeile, 6) = Zahlen(n, 1)
End If
Next
Next
Next
Next
Next
Next
Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg
Application.StatusBar = False
End Sub


für jede hilfe wäre ich sehr dankbar. grüße daniel
mfg
yusuf

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: kombinationen aus bestimmten zahlen
07.12.2007 10:52:50
bst
Hi yusuf,
1. ReDim Erg(Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5))
ist falsch. Du brauchst da einen:
ReDim Erg(1 To Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5), 1 To 6)
2. If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then
reicht nicht aus. Das testet nur die i's mit den anderen Variablen, Du musst alle untereinander testen.
Versuche mal sowas.
cu, Bernd
--
Option Explicit

Sub test()
    Dim Zahlen
    Dim Anz As Long
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim Zeile As Long
    Dim Erg
    Dim dic As Object
    
    Set dic = CreateObject("scripting.dictionary")
    Anz = Range("Anz")
    Redim Erg(1 To Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5), 1 To 6)
    Zahlen = Range("Zahlenliste").Resize(Anz, 1)
    Zeile = 0
    Range("C:H").ClearContents
    For i = 1 To Anz
        Application.StatusBar = "Bearbeitet: " & Format(i / Anz, "0%")
        For j = 1 To Anz
            For k = 1 To Anz
                For l = 1 To Anz
                    For m = 1 To Anz
                        For n = 1 To Anz
                            If IsEachNumberUnique(dic, i, j, k, l, m, n) Then
                                Zeile = Zeile + 1
                                Erg(Zeile, 1) = Zahlen(i, 1)
                                Erg(Zeile, 2) = Zahlen(j, 1)
                                Erg(Zeile, 3) = Zahlen(k, 1)
                                Erg(Zeile, 4) = Zahlen(l, 1)
                                Erg(Zeile, 5) = Zahlen(m, 1)
                                Erg(Zeile, 6) = Zahlen(n, 1)
                            End If
                        Next
                    Next
                Next
            Next
        Next
    Next
    Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg
    Application.StatusBar = False
End Sub

Private Function IsEachNumberUnique(dic As Object, i&, j&, k&, l&, m&, n&) As Boolean
    dic.RemoveAll
    dic.Add i, 0
    
    If dic.Exists(j) Then Exit Function
    dic.Add j, 0
    
    If dic.Exists(k) Then Exit Function
    dic.Add k, 0
    
    If dic.Exists(l) Then Exit Function
    dic.Add l, 0
    
    If dic.Exists(m) Then Exit Function
    dic.Add m, 0
    
    If dic.Exists(n) Then Exit Function
    IsEachNumberUnique = True
End Function


Anzeige
AW: kombinationen aus bestimmten zahlen
07.12.2007 22:43:00
yusuf
hallo bst,
vielen dank für deine antwort ich habe den code kopiert und ausgeführt.
es funktioniert, aber ich habe nur sechs zahlen ausgesucht und er hat mir 720 möglichkeiten angezeigt. 720 deswegen weil er die sechs zahlen untereinander verschiebt. normal müste es ja nur eine einzige kombination sein, weil sich die zahlenkombination genau mit den sechs zahlen nicht wiederholen darf.
wäre dankbar für jede hilfe
mfg
yusuf

AW: kombinationen aus bestimmten zahlen
07.12.2007 23:32:13
bst
Abend yusuf,
da habe ich mich von Deiner Anzahl-Berechnung wohl überlisten lassen :-(
Für k = 6 entspricht n * (n - 1) * (n - 2) * (n - 3) * (n - 4) * (n - 5) nämlich n! / (n-k)! und damit genau der Anzahl der Variationen ohne Zurücklegen. Du willst aber wohl doch Kombinationen ohne Zurücklegen...
Siehe: http://de.wikipedia.org/wiki/Kombinatorik
Das ist zudem M.E. auch noch viel einfacher ;-)
cu, Bernd
--
Option Explicit

Sub test()
    Dim Zahlen
    Dim Anz As Long
    Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
    Dim Zeile As Long
    Dim Erg
    
    Anz = Range("Anz")
    ReDim Erg(1 To WorksheetFunction.Combin(Anz, 6), 1 To 6)
    Zahlen = Range("Zahlenliste").Resize(Anz, 1)
    Zeile = 0
    Range("C:H").ClearContents
    For i = 1 To Anz
        Application.StatusBar = "Bearbeitet: " & Format(i / Anz, "0%")
        For j = i + 1 To Anz
            For k = j + 1 To Anz
                For l = k + 1 To Anz
                    For m = l + 1 To Anz
                        For n = m + 1 To Anz
                            Zeile = Zeile + 1
                            Erg(Zeile, 1) = Zahlen(i, 1)
                            Erg(Zeile, 2) = Zahlen(j, 1)
                            Erg(Zeile, 3) = Zahlen(k, 1)
                            Erg(Zeile, 4) = Zahlen(l, 1)
                            Erg(Zeile, 5) = Zahlen(m, 1)
                            Erg(Zeile, 6) = Zahlen(n, 1)
                        Next
                    Next
                Next
            Next
        Next
    Next
    Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg
    Application.StatusBar = False
End Sub

Anzeige
yippiiii es funzt
08.12.2007 12:43:28
yusuf
hallo bernd,
ich möchte mich ganz herzlich, speziell bei dir und natürlich bei allen anderen die hier immer wieder gerne anderen leuten helfen bedanken. es funzt super und genau wie ich es mir vorgestellt habe.
yippiiiiiiii. ich liebe dich;-)
mfg
yusuf

55 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige