AW: leider noch nix
02.02.2004 16:54:28
Dieter
Hallo Andi!
Danke für Deinen Einsatz. Sepp hatte mir zwischenzeitlich auch geantwortet (vielleicht hast Du sogar sein Posting gelesen. Damit kam ich schon echt weit. Ich liste mal seinen Vorschlag und mein Dazutun ab, weil das eigentlich schon ganz gut funzt. Bis jetzt habe ich maximal 10 Kombinationsmöglichkeiten, könnte das aber glaube ich auch unbegrenzt fortführen. Nur mein Rechner macht dann langsam schlapp. Bei dreißig zu kombinierenden Ziffern werden schon über 53 Millionen Möglichkeiten abgearbeitet, und je mehr Ziffern ich nehme, desto progressiver steigt die Kurve.
Sub Summand_Kombinationen_berechnen()
Dim Werte As Range
Dim spalte As Integer
Dim zeile As Long
Dim zStart As Long
Dim Gesucht As Double, Kombinationen As Double
Dim Startzeit As Variant
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As Integer
'I. Wertezelle feststellen & Inputbox darstellen
Set Werte = Selection
spalte = Werte.Row + 3
zeile = Werte(1).Row
zStart = zeile
'Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
Kombinationen = Application.Combin(Werte.Count, 2) + Application.Combin(Werte.Count, 3) _
+ Application.Combin(Werte.Count, 4) _
+ Application.Combin(Werte.Count, 5) _
+ Application.Combin(Werte.Count, 6) _
+ Application.Combin(Werte.Count, 7) _
+ Application.Combin(Werte.Count, 8) _
+ Application.Combin(Werte.Count, 9) _
+ Application.Combin(Werte.Count, 10) _
'InputBox gibt einen String zurück, daher muß bei u.g. Vergleich der Rückgabestring
'mit CDbl in eine Zahl umgewandelt werden
Gesucht = CDbl(InputBox("Für die angegebene Summe werden alle Kombinationsmöglichkeiten aus den einzelnen Summanden errechnet. " & _
"Maximal " & Kombinationen & " Kombinationsmöglichkeiten werden durchgerechnet ! " & Chr(13) & _
Chr(13) & "Bitte die Summe angeben:"))
'Dauer der Berechnung feststellen (Timer auf Null stellen)
Startzeit = Timer
Application.ScreenUpdating = False
'II. Berechnung mit 2 Möglichkeiten
'die innere Schleife muß zwingend bei a+1 und nicht bei 2 beginnen
'( ansonsten wird a+ b und b+ a gerechnet !)
For a = 1 To Werte.Cells.Count - 1
For b = a + 1 To Werte.Cells.Count
'Range("A1").Activate
'Binäre Rechenmethoden und deren Umandlung in absolute Zahlen kann zu
'Problemen führen (Bsp.: 1 + 2 = 2,999988 !). Besser ist es statt dessen
'auf eine möglichst kleine Differenz zu prüfen
["ABS(Berechnet-Gesucht) <0.001]
If Abs(Werte.Cells(a) + Werte.Cells(b) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & Werte.Cells(b) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
'III. Berechnung mit 3 Möglichkeiten
For a = 1 To Werte.Cells.Count - 2
For b = a + 1 To Werte.Cells.Count - 1
For c = b + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
'IV. Berechnung mit 4 Möglichkeiten
For a = 1 To Werte.Cells.Count - 3
For b = a + 1 To Werte.Cells.Count - 2
For c = b + 1 To Werte.Cells.Count - 1
For d = c + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & Werte.Cells(d) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
'V. Berechnung mit 5 Möglichkeiten
For a = 1 To Werte.Cells.Count - 4
For b = a + 1 To Werte.Cells.Count - 3
For c = b + 1 To Werte.Cells.Count - 2
For d = c + 1 To Werte.Cells.Count - 1
For e = d + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) + Werte.Cells(e) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & _
Werte.Cells(d) & " + " & Werte.Cells(e) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
Next
'VI. Berechnung mit 6 Möglichkeiten
For a = 1 To Werte.Cells.Count - 5
For b = a + 1 To Werte.Cells.Count - 4
For c = b + 1 To Werte.Cells.Count - 3
For d = c + 1 To Werte.Cells.Count - 2
For e = d + 1 To Werte.Cells.Count - 1
For f = e + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) + Werte.Cells(e) + Werte.Cells(f) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & _
Werte.Cells(d) & " + " & Werte.Cells(e) & " + " & Werte.Cells(f) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
Next
Next
'VII. Berechnung mit 7 Möglichkeiten
For a = 1 To Werte.Cells.Count - 6
For b = a + 1 To Werte.Cells.Count - 5
For c = b + 1 To Werte.Cells.Count - 4
For d = c + 1 To Werte.Cells.Count - 3
For e = d + 1 To Werte.Cells.Count - 2
For f = e + 1 To Werte.Cells.Count - 1
For g = f + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) + Werte.Cells(e) + Werte.Cells(f) + Werte.Cells(g) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & _
Werte.Cells(d) & " + " & Werte.Cells(e) & " + " & Werte.Cells(f) & " + " & Werte.Cells(g) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
Next
Next
Next
'VIII. Berechnung mit 8 Möglichkeiten
For a = 1 To Werte.Cells.Count - 7
For b = a + 1 To Werte.Cells.Count - 6
For c = b + 1 To Werte.Cells.Count - 5
For d = c + 1 To Werte.Cells.Count - 4
For e = d + 1 To Werte.Cells.Count - 3
For f = e + 1 To Werte.Cells.Count - 2
For g = f + 1 To Werte.Cells.Count - 1
For h = g + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) + Werte.Cells(e) + Werte.Cells(f) + Werte.Cells(g) + Werte.Cells(h) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & _
Werte.Cells(d) & " + " & Werte.Cells(e) & " + " & Werte.Cells(f) & " + " & Werte.Cells(g) & " + " & Werte.Cells(h) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
Next
Next
Next
Next
'IX. Berechnung mit 9 Möglichkeiten
For a = 1 To Werte.Cells.Count - 8
For b = a + 1 To Werte.Cells.Count - 7
For c = b + 1 To Werte.Cells.Count - 6
For d = c + 1 To Werte.Cells.Count - 5
For e = d + 1 To Werte.Cells.Count - 4
For f = e + 1 To Werte.Cells.Count - 3
For g = f + 1 To Werte.Cells.Count - 2
For h = g + 1 To Werte.Cells.Count - 1
For i = h + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) + Werte.Cells(e) + Werte.Cells(f) + Werte.Cells(g) + Werte.Cells(h) + Werte.Cells(i) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & _
Werte.Cells(d) & " + " & Werte.Cells(e) & " + " & Werte.Cells(f) & " + " & Werte.Cells(g) & " + " & Werte.Cells(h) & " + " & Werte.Cells(i) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
'X. Berechnung mit 10 Möglichkeiten
For a = 1 To Werte.Cells.Count - 9
For b = a + 1 To Werte.Cells.Count - 8
For c = b + 1 To Werte.Cells.Count - 7
For d = c + 1 To Werte.Cells.Count - 6
For e = d + 1 To Werte.Cells.Count - 5
For f = e + 1 To Werte.Cells.Count - 4
For g = f + 1 To Werte.Cells.Count - 3
For h = g + 1 To Werte.Cells.Count - 2
For i = h + 1 To Werte.Cells.Count - 1
For j = i + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) + Werte.Cells(c) + _
Werte.Cells(d) + Werte.Cells(e) + Werte.Cells(f) + Werte.Cells(g) + Werte.Cells(h) + Werte.Cells(i) + Werte.Cells(j) - Gesucht) < 0.001 Then
Cells(zeile, spalte) = Werte.Cells(a) & " + " & _
Werte.Cells(b) & " + " & Werte.Cells(c) & " + " & _
Werte.Cells(d) & " + " & Werte.Cells(e) & " + " & Werte.Cells(f) & " + " & Werte.Cells(g) & " + " & Werte.Cells(h) & " + " & Werte.Cells(i) & " + " & Werte.Cells(j) & " = " & Gesucht
zeile = zeile + 1
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Application.ScreenUpdating = True
MsgBox "Dauer : " & Timer - Startzeit & " Sekunden!" & vbLf & vbLf & _
"Es wurden " & zeile - zStart & " Kombinationen gefunden!"
End Sub
Wenn Du was findest, was einfacher geht und nicht so zeitintensiv ist......
Vielleicht meldet sich auch jemand aus dem Mathe-Forum!!!
Schöne Grüße
Dieter