Zahlenkombinationen vergleichen um Summaden zu ermitteln
Bernd Bertels
Ich möchte aus einer Vielzahl von Beträgen - die untereinander in
Tabellenspalte A stehen - eine bestimmte Summe ermitteln lassen, wobei 2
Summanden kombiniert diese Summe ergeben sollen.
Die Summe der unbekannten Summanden gebe ich dabei vorher in einem
Eingabefenster an.
Nach Berechnung der möglichen zusammenpassenden Summanden soll die
errechnete Lösung dann am Bildschirm in einem Meldungsfenster dargestellt
werden.
Meine Frage lautet: wie kann ich mittels einer For-Next-Schleife VBA dazu
bewegen, alle möglichen Kombinationen (= Zellinhalte aus Spalte A)
durchzuaddieren, bis es zur Lösung kommt ?
Das unten aufgeführte Makro ermittelt nach meinen durchgeführten Stichproben
leider nicht alle Kombinationsmöglichkeiten, sondern läßt manche außer acht.
Irgendwie muß ich die Beispieldatei auf dem Excel-Server von Hans W. Herber
für die Berechnung von Kombinationen falsch interpretiert haben. Vielen Dank
für Hilfe im voraus !!!
Bernd
Sub Betrags_Kombinationen()
Dim GesuchterBetrag As Single
Dim ErrechneterBetrag As Single
Dim ErsterSummand As Single
Dim ZweiterSummand As Single
Dim a As Integer
Dim b As Integer
Dim i As Integer
GesuchterBetrag = InputBox("Bitte die Summe der zwei unbekannten Summanden
angeben:")
Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
'die Wertezellen markieren
i = Selection.Count 'Anzahl der vorhandenen Wertezellen einer Variablen
zuweisen
For a = 1 To i - 1
For b = 2 To i
ErsterSummand = Worksheets("Tabelle1").Cells(a, 1)
ZweiterSummand = Worksheets("Tabelle1").Cells(b, 1)
ErrechneterBetrag = ErsterSummand + ZweiterSummand
If ErrechneterBetrag = GesuchterBetrag Then
msgbox "Gefunden! " & ErsterSummand & " und " & _
ZweiterSummand & " ergeben " & GesuchterBetrag & " !"
Exit Sub
End If
Next b
Next a
End Sub
Folgende Zahlen stehen (testweise) in den Zelle von A1 bis A10 im Excelblatt
"Tabelle1":
8
12,2
56
85
98,1
74,1
14
55
22,2
23,6
Folgende Summe wird bspw. nicht erkannt: 22,2 + 23,6 = 45,8
Wolfgang Zeinar
Bernd Bertels schrieb in Nachricht ...
>Meine Frage lautet: wie kann ich mittels einer For-Next-Schleife VBA
dazu
>bewegen, alle möglichen Kombinationen (= Zellinhalte aus Spalte A)
>durchzuaddieren, bis es zur Lösung kommt ?
>Das unten aufgeführte Makro ermittelt nach meinen durchgeführten
Stichproben
>leider nicht alle Kombinationsmöglichkeiten, sondern läßt manche außer
acht.
>Irgendwie muß ich die Beispieldatei auf dem Excel-Server von Hans W.
Herber
>für die Berechnung von Kombinationen falsch interpretiert haben. Vielen
Dank
>für Hilfe im voraus !!!
>
>Sub Betrags_Kombinationen()
>[...]
> If ErrechneterBetrag = GesuchterBetrag Then
> msgbox "Gefunden! " & ErsterSummand & " und " & _
> ZweiterSummand & " ergeben " & GesuchterBetrag & "
!"
> Exit Sub ' <======
> End If
>[...]
>End Sub
Ohne die Formel weiter geprüft zu haben, aber hier "liegt der Hund
begraben". Wenn der erste passende Betrag gefunden wird, wird die
Sub-Prozedur verlassen. Entferne die Zeile "Exit Sub" (oder kommentiere
sie aus) und laß das Makro dann mal laufen.
HTH
Wolfgang
Michael Schwimmer
Der Knackpunkt bei dem Code ist die Zeile
Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
Mit: i = Selection.Count 'Anzahl der vorhandenen Wertezellen einer
Variablen
hast du zwar die Anzahl der vorhandenen Wertezellen, du hast damit aber
nicht die letzte Zelle der Spalte.
In der Schleife probierst du also nur die Kombinationen bis in die Zeile i.
Anders ausgedrückt, wenn z.B. in der Spalte A die letzte Zelle mit einer
Zahl die Zelle A28 ist, du aber zwischendrin 10 leere Zellen hast, hört
deine Berechnung in der Zeile 18 auf. Modifiziere das Makro ein bischen.
Sub Kombination()
Dim GesuchterBetrag As Single
Dim ErrechneterBetrag As Single
Dim ErsterSummand As Single
Dim ZweiterSummand As Single
Dim a&, b&, i&
On Error GoTo Fehlerbehandlung
GesuchterBetrag = InputBox("Bitte die Summe der zwei unbekannten Summanden
angeben:")
i = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row
For a = 1 To i - 1
For b = a + 1 To i
ErsterSummand = Worksheets("Tabelle3").Cells(a, 1)
ZweiterSummand = Worksheets("Tabelle3").Cells(b, 1)
If IsNumeric(ErsterSummand) And IsNumeric(ZweiterSummand) Then
ErrechneterBetrag = ErsterSummand + ZweiterSummand
If ErrechneterBetrag = GesuchterBetrag Then
MsgBox "Gefunden! " & ErsterSummand & " und " & _
ZweiterSummand & " ergeben " & GesuchterBetrag & " !"
Exit Sub
End If
End If
Next b
Next a
Fehlerbehandlung:
End Sub
Trotzdem hätte das Makro bei deinem Beispiel funktionieren müssen. Ist
vielleicht der Zellinhalt in Spalte 1 das Ergebnis einer Berechnung? Excel
rechnet intern mit mehr Nachkommastellen, als vielleicht angezeigt werden.
Das Ergebnis muß aber exakt übereinstimmen. Eventuell mußt du vorher Runden.
Auch wenn ein Zellinhalt versehentlich Text ist, klappt die ganze Sache
nicht.
MfG
Michael
Bernd Bertels schrieb in Nachricht ...
>Hallo Exceljaner !
>
>Ich möchte aus einer Vielzahl von Beträgen - die untereinander in
>Tabellenspalte A stehen - eine bestimmte Summe ermitteln lassen, wobei 2
>Summanden kombiniert diese Summe ergeben sollen.
>Die Summe der unbekannten Summanden gebe ich dabei vorher in einem
>Eingabefenster an.
>Nach Berechnung der möglichen zusammenpassenden Summanden soll die
>errechnete Lösung dann am Bildschirm in einem Meldungsfenster dargestellt
>werden.
>
>Meine Frage lautet: wie kann ich mittels einer For-Next-Schleife VBA dazu
>bewegen, alle möglichen Kombinationen (= Zellinhalte aus Spalte A)
>durchzuaddieren, bis es zur Lösung kommt ?
>Das unten aufgeführte Makro ermittelt nach meinen durchgeführten
Stichproben
>leider nicht alle Kombinationsmöglichkeiten, sondern läßt manche außer
acht.
>Irgendwie muß ich die Beispieldatei auf dem Excel-Server von Hans W. Herber
>für die Berechnung von Kombinationen falsch interpretiert haben. Vielen
Dank
>für Hilfe im voraus !!!
>
>Bernd
>
>
>Sub Betrags_Kombinationen()
> Dim GesuchterBetrag As Single
> Dim ErrechneterBetrag As Single
> Dim ErsterSummand As Single
> Dim ZweiterSummand As Single
> Dim a As Integer
> Dim b As Integer
> Dim i As Integer
> GesuchterBetrag = InputBox("Bitte die Summe der zwei unbekannten Summanden
>angeben:")
> Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
>'die Wertezellen markieren
> i = Selection.Count 'Anzahl der vorhandenen Wertezellen einer
Variablen
>zuweisen
> For a = 1 To i - 1
> For b = 2 To i
> ErsterSummand = Worksheets("Tabelle1").Cells(a, 1)
> ZweiterSummand = Worksheets("Tabelle1").Cells(b, 1)
> ErrechneterBetrag = ErsterSummand + ZweiterSummand
> If ErrechneterBetrag = GesuchterBetrag Then
> msgbox "Gefunden! " & ErsterSummand & " und " & _
> ZweiterSummand & " ergeben " & GesuchterBetrag & " !"
> Exit Sub
Bernd Bertels
Vielen Dank für Deine Unterstützung, Michael.
Leider funktioniert das Makro aber noch nicht wie gewünscht: die Addition
der zwei letztgenannten Werte in den Zellen A9 und A10 (Wert 22,2 und Wert
23,6) funktioniert immer noch nicht, da mein Makro sie nicht als Summanden
für die Summe 45,8 erkennt (alle anderen durchprobierten Werte dagegen
schon).
Liegt es vielleicht an der gewählten For-Next-Schleife, indem sie nicht alle
möglichen Summanden erkennt und durchrechnet ?
In den Zellen A1 bis A10 der Tabelle1 befinden sich nur die 10 Werte - keine
evtl. Formeln oder anderes - ansonsten ist sie völlig leer (Mit der
IsNumeric-Funktion, die Du ja in mein Makro eingefügt hattest, kan man nun
endgülig festlegen, daß das Makro nur Werte - keine Texte o.ä. aufgreift und
fehlerhaft interpretieren würde.)
Vielleicht fällt Dir oder jemand anderem noch ein Tip hierzu ein.
Ach ja, ich vergaß bisher: ich habe die Version Excel97.
Nochmals Dank im voraus.
Gruß, Bernd.
Michael Schwimmer schrieb in Nachricht <7888r0$tk0$1...@news06.btx.dtag.de>...
Wolfgang Zeinar
Bernd Bertels schrieb in Nachricht ...
>
>Liegt es vielleicht an der gewählten For-Next-Schleife, indem sie nicht
alle
>möglichen Summanden erkennt und durchrechnet ?
>Michael Schwimmer schrieb in Nachricht
<7888r0$tk0$1...@news06.btx.dtag.de>...
>>
>>Sub Kombination()
>>[...]
>> If ErrechneterBetrag = GesuchterBetrag Then
>> MsgBox "Gefunden! " & ErsterSummand & " und " & _
>> ZweiterSummand & " ergeben " & GesuchterBetrag & "
!"
>> Exit Sub
>> End If
>> End If
>>[...]
>>End Sub
Da ist immer noch die "Exit Sub" drin!!!
Der Code lautet: wenn ErrechneterBetrag = GesuchterBetrag dann mach eine
Meldung und verlasse die Sub. Also wird die Prozedur verlassen, nachdem
das *ERSTE* Paar gefunden wurde.
mfg
Wolfgang
Bernd Bertels
Erstmal mille gracie für Deine bisherige Hilfe !
Nun zu dem "Exit sub": Mit dem Verlassen der Schleife wollte ich
ursprünglich erreichen, daß - nachdem die ersten möglichen zusammenpassenden
Summanden gefunden werden - das Makro abgebrochen wird.
Die Zahlen, die später in der eigentlichen Anwendung durchsucht werden
sollen, besitzen derart unterschiedliche Beträge in Tausender Mark und
Pfennig, daß Doppellösungen unwahrscheinlich sind. Die Meldung gibt mir die
zusammenpassenden Summanden aus - ich vermerke dies auf meiner Liste - und
danach ist das Weiterlaufen des Makros sinnlos, da die Lösung bereits
gefunden wurde (Das Makro soll später mal in der Buchhaltung und
Betriebsabrechnung nützlich werden, wo es um große Zahlenbestände geht).
Nichtsdestotrotz hab ich Deine Idee der Auskommentierung befolgt, aber
leider ohne Erfolg.
Das Problem besteht wirklich darin, daß von meinem hier dargestellten
Beispiel mit 10 möglichen Summanden a u s g e r e c h n e t die beiden
untersten nicht als Additionsmöglichkeit vom Progrämmchen akzeptiert werden.
Das kann doch eigentlich nur an der For-Next-Schleife liegen, oder ?
Ich muss zugeben, ich fand in der Volkswirtschaftslehre die Keynessche
Investitionsgleichung verständlicher als das Nachvollziehen, ob den diese
For-Next-Struktur auch alles abgreift :-)
Falls Dir, Michael oder den anderen noch was einfällt, merci beaucoup im
voraus.
## Schönes Wochenende wünsch' ich allen !!! ##
Gruß Bernd.
Wolfgang Zeinar schrieb in Nachricht ...
Andreas Steffens
>Leider funktioniert das Makro aber noch nicht wie gewünscht: die Addition
>der zwei letztgenannten Werte in den Zellen A9 und A10 (Wert 22,2 und Wert
>23,6) funktioniert immer noch nicht, da mein Makro sie nicht als Summanden
>für die Summe 45,8 erkennt (alle anderen durchprobierten Werte dagegen
>schon).
Der Vergleich einer Berechnung mit einem absoluten Wert ist immer sehr
kritisch. Selbst, wenn man den Code im Ablauf überwacht, führt die Abfrage
ErrechneterBetrag = GesuchterBetrag
zum Ergebnis FALSE, obwohl scheinbar beide Variablen den Wert 45,8
enthalten. Dies hängt mit den binären Rechenmethoden und den dabei nötigen
umwandlungen zusammen. Besser ist es in jedem Fall, statt auf den genauen
Wert nur auf eine möglichst kleine Differenz zu prüfen, also statt
Berechnet=Gesucht
besser
ABS(Berechnet-Gesucht) <0.001
Hier Deine Routine in leicht geänderter Form (Sie bezieht sich auf Tabelle1,
Spalte1, das kannst Du aber in der Zeile "Set Werte..." ändern):
Sub Kombination2()
Dim Werte As Range
Dim Gesucht As Double
Dim a As Integer, b As Integer
Gesucht = CDbl(InputBox("Bitte die Summe der zwei unbekannten Summanden
angeben:"))
Set Werte = Worksheets(1).Columns(1).SpecialCells(xlConstants, xlNumbers)
For a = 1 To Werte.Cells.Count - 1
For b = a + 1 To Werte.Cells.Count
If Abs(Werte.Cells(a) + Werte.Cells(b) - Gesucht) < 0.001 Then
MsgBox "Gefunden: " & Chr(10) & _
Werte.Cells(a) & " + " & Werte.Cells(b) & " = " & Gesucht &
Chr(10) & _
"(" & Werte.Cells(a).Address(False, False) & " + " _
& Werte.Cells(b).Address(False, False) & ")"
Exit Sub
End If
Next
Next
MsgBox "Keine Kombination für den Wert " & Gesucht & " gefunden."
End Sub
HTH,
Andreas
>>Sub Kombination()
>>Dim GesuchterBetrag As Single
>>Dim ErrechneterBetrag As Single
>>Dim ErsterSummand As Single
>>Dim ZweiterSummand As Single
>>Dim a&, b&, i&
>>On Error GoTo Fehlerbehandlung
>>GesuchterBetrag = InputBox("Bitte die Summe der zwei unbekannten Summanden
>>angeben:")
>>i = Worksheets("Tabelle3").Cells(Rows.Count, 1).End(xlUp).Row
>>For a = 1 To i - 1
>> For b = a + 1 To i
>> ErsterSummand = Worksheets("Tabelle3").Cells(a, 1)
>> ZweiterSummand = Worksheets("Tabelle3").Cells(b, 1)
>> If IsNumeric(ErsterSummand) And IsNumeric(ZweiterSummand) Then
>> ErrechneterBetrag = ErsterSummand + ZweiterSummand
>> If ErrechneterBetrag = GesuchterBetrag Then
>> MsgBox "Gefunden! " & ErsterSummand & " und " & _
>> ZweiterSummand & " ergeben " & GesuchterBetrag & " !"
>> Exit Sub
>> End If
>> End If
Michael Schwimmer
Ich habe das noch mal überprüft, und siehe da, du hast recht. Wenigstens zum
Teil. Es werden alle Kombinationen durchprobiert, jedenfalls bis das erste
Ergebnis richtig ist. Der Fehler liegt in der Addition zweier Single
Datentypen. Ich bekomme beim Debuggen als Ergebnis der Addition 45,8
angezeigt, als Suchwert auch 45,8. Trotzdem ist die Summe größer als der
Suchwert. Liegt an der internen Darstellung des Single Datentyps. Die
Bedingung ist deshalb niemals wahr, weshalb die MsgBox nicht angezeigt wird.
Beim Ausprobieren hatte ich ganze Zahlen verwendet, womit das Makro
funktioniert hat.
Ersetze folgende Zeile:
ErrechneterBetrag = ErsterSummand + ZweiterSummand
durch diese:
ErrechneterBetrag = Application.Round(ErsterSummand + ZweiterSummand, 2)
Du rundest dann auf zwei Stellen hinter dem Komma und die Sache
funktioniert.
MfG
Michael
Bernd Bertels schrieb in Nachricht ...
>Hallo Michael und alle andere Excel-Tüftler !
>
>Vielen Dank für Deine Unterstützung, Michael.
>Leider funktioniert das Makro aber noch nicht wie gewünscht: die Addition
>der zwei letztgenannten Werte in den Zellen A9 und A10 (Wert 22,2 und Wert
>23,6) funktioniert immer noch nicht, da mein Makro sie nicht als Summanden
>für die Summe 45,8 erkennt (alle anderen durchprobierten Werte dagegen
>schon).
>Liegt es vielleicht an der gewählten For-Next-Schleife, indem sie nicht
alle
>möglichen Summanden erkennt und durchrechnet ?
Michael Schwimmer
Richtig!!
So wie ich die Anfrage verstanden hatte, sollte das auch so sein. Bei dem
Beispiel von Bernd war auch keine andere Möglichkeit da, die den vorzeitigen
Schleifenabbruch bewirken konnte.
Einfach das Exit Sub wegzulassen, wie du vorgeschlagen hast, ist aber auch
nicht der richtige Weg. Du hast dann keine Gelegenheit, das Programm zu
verlassen, bis jede Möglichkeit durchgerechnet ist. Bei mehreren positiven
Suchergebnissen mußt du auch jedesmal die MsgBox wegklicken.
Ich würde daher beim Aufruf der MsgBox dem Anwender die Möglichkeit geben,
das Suchen zu beenden oder weiterzusuchen.
MfG
Michael
Wolfgang Zeinar schrieb in Nachricht ...
Martin Beck
ich habe Deinen Code mit EXCEL 7.0 getestet und drei Schwächen
gefunden, die ich in nachfolgender Version abgestellt habe.
1) Die Deklarierung As Single führt dazu, daß z.B. 22,6 + 23,2 nicht 45,8,
sondern 45,7999992370605 ergeben, daher habe ich diese Deklarierung
entfernt. Der Effekt läßt sich nachvollziehen, indem man den gesuchten und
den errechneten Wert
in eine Zelle (z.B. G1 und H1) schreiben läßt. Die entsprechenden
Anweisungen sind in meinem Makro als Kommentar enthalten, Du kannst es also
leicht ausprobieren.
2) InputBox gibt einen String zurück. Beim Vergleich mit Zahlen führt das zu
Problemen und zwar offensichtlich immer dann, wenn Zahlen mit
Nachkommastellen vorkommen. Lösung: Den Rückgabestring mit CDbl in eine Zahl
umwandeln.
3) So wie Du die Zähler in den Schleifen gewählt hast, werden alle
gefundenen Lösungen zweimal angezeigt, und zwar als Kombination (a,b) und
(b,a). Lösung: Die innere Schleife muß bei a+1 und nicht bei 2 beginnen. Die
Laufzeit wird dadurch auch verringert, da bereits überprüfte Kombinationen
nicht noch einmal durchlaufen werden.
4) Auf das "Exit Sub", das das Auffinden mehrerer Lösungen verhindert, wurde
bereits hingewiesen.
HTH
Gruß
Martin Beck
Sub Betrags_Kombinationen()
'Dim GesuchterBetrag As Single
'Dim ErrechneterBetrag As Single
'Dim ErsterSummand As Single
'Dim ZweiterSummand As Single
Dim a As Integer
Dim b As Integer
Dim i As Integer
GesuchterBetrag = CDbl(InputBox("Bitte die Summe der zwei unbekannten
Summanden angeben:"))
Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
'die Wertezellen markieren
i = Selection.Count 'Anzahl der vorhandenen Wertezellen einer Variablen
zuweisen
For a = 1 To i - 1
For b = a + 1 To i
ErsterSummand = Worksheets("Tabelle1").Cells(a, 1)
ZweiterSummand = Worksheets("Tabelle1").Cells(b, 1)
ErrechneterBetrag = ErsterSummand + ZweiterSummand
'[g1] = GesuchterBetrag
'[h1] = ErrechneterBetrag
If ErrechneterBetrag = GesuchterBetrag Then
MsgBox "Gefunden! " & ErsterSummand & " und " & _
ZweiterSummand & " ergeben " & GesuchterBetrag & " !"
'Exit Sub
End If
Next b
Next a
End Sub
Bernd Bertels schrieb in Nachricht ...
>Hallo Exceljaner !
>
>Ich möchte aus einer Vielzahl von Beträgen - die untereinander in
>Tabellenspalte A stehen - eine bestimmte Summe ermitteln lassen, wobei 2
>Summanden kombiniert diese Summe ergeben sollen.
>Die Summe der unbekannten Summanden gebe ich dabei vorher in einem
>Eingabefenster an.
>Nach Berechnung der möglichen zusammenpassenden Summanden soll die
>errechnete Lösung dann am Bildschirm in einem Meldungsfenster dargestellt
>werden.
>
>Meine Frage lautet: wie kann ich mittels einer For-Next-Schleife VBA dazu
>bewegen, alle möglichen Kombinationen (= Zellinhalte aus Spalte A)
>durchzuaddieren, bis es zur Lösung kommt ?
>Das unten aufgeführte Makro ermittelt nach meinen durchgeführten
Stichproben
>leider nicht alle Kombinationsmöglichkeiten, sondern läßt manche außer
acht.
>Irgendwie muß ich die Beispieldatei auf dem Excel-Server von Hans W. Herber
>für die Berechnung von Kombinationen falsch interpretiert haben. Vielen
Dank
>für Hilfe im voraus !!!
>
>Bernd
>
>
>Sub Betrags_Kombinationen()
> Dim GesuchterBetrag As Single
> Dim ErrechneterBetrag As Single
> Dim ErsterSummand As Single
> Dim ZweiterSummand As Single
> Dim a As Integer
> Dim b As Integer
> Dim i As Integer
> GesuchterBetrag = InputBox("Bitte die Summe der zwei unbekannten Summanden
>angeben:")
> Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
>'die Wertezellen markieren
> i = Selection.Count 'Anzahl der vorhandenen Wertezellen einer
Variablen
>zuweisen
> For a = 1 To i - 1
> For b = 2 To i
> ErsterSummand = Worksheets("Tabelle1").Cells(a, 1)
> ZweiterSummand = Worksheets("Tabelle1").Cells(b, 1)
> ErrechneterBetrag = ErsterSummand + ZweiterSummand
> If ErrechneterBetrag = GesuchterBetrag Then
> msgbox "Gefunden! " & ErsterSummand & " und " & _
> ZweiterSummand & " ergeben " & GesuchterBetrag & " !"
> Exit Sub
> End If
> Next b
> Next a
>End Sub
>
Bernd Bertels
Vielen Dank für eure Hilfe, das Progrämmchen funktioniert jetzt
einwandfrei mit den Anpassungen von Martin und Andreas.
Und ich dachte schon, ich müßte mich mit der Lösung "42" begnügen: die
universell richtige Antwort auf ungelöste Fragen lautet stets 42
(entnommen aus der TV-Serie "Per Anhalter durch die Galaxis" ...).
Die fehlerhafte Single-Deklarierung bzw. die Umwandlung von binären
Rechenmethoden (1 + 2 = 2,99999788 u.ä.) muß man sich echt merken. Das
mit der String-Rückgabe bei der InputBox hab ich irgendwo schon mal
gelesen, aber hier nicht bedacht.
Am wichtigsten find ich die Veränderung meiner Schleifendurchläufe ("die
innere Schleife muß bei a+1 und nicht bei 2 beginnen"). In einem
späteren Schritt will ich nämlich das Makro so erweitern, daß 2 bis
maximal 5 Summandenkombinationen durchgerechnet werden - ohne genaue
Kenntnis was die Schleifen berechnen ansonsten unmöglich.
Bis demnächst,
Bernd.
Kohki SAITO
Mich interessiert etwas ähnliches.
Ich habe auch eine Spalte mit Werten und möchte auch den Zielwert
vorgeben; jedoch soll Excel alle möglichen Varianten untersuchen
(variable Anzahl von Summanden - aber nicht doppelt).
Danke im voraus - falls jemand antwortet (hoffentlich)
Bernd Bertels
Die eigentliche Lösung auf Deine Frage hab zwar nicht, aber ich zeige
Dir mal mein nun angpaßtes Makro, welches bis zu 5 mögliche Summanden
als Summe durchrechnet: erst 2, dann 3, 4 und schließlich 5
Kombinationsmöglichkeiten (mehr wären es in meinem Fall sowieso kaum
möglich).
Ich geb' zu, daß das Makro ziemlich lang wurde, mitunter auch durch
kleine Ergänzungen, die ich den Meldungsfenstern mitgeben wollte.
Aber vielleicht wissen die anderen Newsgroup-Teilnehmer, wie man das
Problem mit einer For-To-Schleife o.ä. verkürzen kann und auf alle
Variablen als Summanden anwenden kann. Problematisch wird's irgendwann
wahrscheinlich mit der Rechenzeit: Excel rechnet sich dumm & dämmlich,
bis es zur eventuellen Lösung kommt.
Jedenfalls wird's immer komplizierter !
Gruß, Bernd.
(ach übrigens, hast Du einen japanischen Namen ?)
Sub Summand_Kombinationen_berechnen()
Dim Werte As Range '= 4 Bytes
Dim Gesucht As Double, Kombinationen As Double '= 8 Bytes
Dim Startzeit As Variant '= 18 Bytes
Dim a As Integer, b As Integer, c As Integer, d As Integer, e As
Integer '= 2 Bytes
'ohne die Fehlerabzweigung bringt VBA eine Fehlermeldung, wenn man das
'Makro im Dialogfenster mittels "Abbrechen" abbricht
On Error GoTo Ende
'I. Wertezelle feststellen & Inputbox darstellen
'-----------------------------------------------
Set Werte = Worksheets(1).Columns(1).SpecialCells(xlConstants,
xlNumbers)
Worksheets(1).UsedRange.SpecialCells(xlConstants, xlNumbers).Select
Kombinationen = Application.Combin(Selection.Count, 2) +
Application.Combin(Selection.Count, 3) _
+ Application.Combin(Selection.Count, 4) +
Application.Combin(Selection.Count, 5)
'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("2 bis 5 Schecks sind zusammen belastet
worden. " & _
"Maximal " & Kombinationen & " Kombinationsmöglichkeiten werden
durchgerechnet ! " & Chr(13) & _
Chr(13) & "Bitte die Summe angeben:"))
'Dauer der Berechnung feststellen (Timer auf Null stellen)
Startzeit = Timer
'II. Berechnung 2 möglicher Scheckkombinationen
'----------------------------------------------
'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
msgbox "Gefunden: " & Werte.Cells(a) & " + " & Werte.Cells(b) &
" = " & Gesucht & Chr(10) & _
"(Zelle " & Werte.Cells(a).Address(False, False) & " + Zelle "
_
& Werte.Cells(b).Address(False, False) & ")." & Chr(10) & "Das
Berechnen dauerte " & _
Application.Round((Timer - Startzeit), 1) & " Sekunden."
Exit Sub
End If
'wenn das Makro länge als 1 Minute zur Berechnung braucht, wird es
abgebrochen
If Timer - Startzeit > 60 Then
msgbox "Abbruch - das Makro brauchte über 1 Minute Laufzeit !"
Exit Sub
End If
Next
Next
'III. Berechnung 3 möglicher Scheckkombinationen
'-----------------------------------------------
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
msgbox "Gefunden: " & Chr(10) & Werte.Cells(a) & " + " &
Werte.Cells(b) & " + " & _
Werte.Cells(c) & " = " & Gesucht & Chr(10) & "(Zelle " &
Werte.Cells(a).Address(False, False) _
& " + Zelle " & Werte.Cells(b).Address(False, False) & " +
Zelle " & _
Werte.Cells(c).Address(False, False) & ")." & Chr(10) & "Das
Berechnen dauerte " & _
Application.Round((Timer - Startzeit), 1) & " Sekunden."
Exit Sub
End If
If Timer - Startzeit > 60 Then
msgbox "Abbruch - das Makro brauchte über 1 Minute Laufzeit !"
Exit Sub
End If
Next
Next
Next
'IV. Berechnung 4 möglicher Scheckkombinationen
'----------------------------------------------
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
msgbox "Gefunden: " & Chr(10) & Werte.Cells(a) & " + " &
Werte.Cells(b) & " + " & _
Werte.Cells(c) & " + " & Werte.Cells(d) & " = " & Gesucht &
Chr(10) & "(Zelle " & Werte.Cells(a).Address(False, False) _
& " + Zelle " & Werte.Cells(b).Address(False, False) & " +
Zelle " & _
Werte.Cells(c).Address(False, False) & " + Zelle " &
Werte.Cells(d).Address(False, False) & ")." & Chr(10) & "Das Berechnen
dauerte " & _
Application.Round((Timer - Startzeit), 1) & " Sekunden."
Exit Sub
End If
If Timer - Startzeit > 60 Then
msgbox "Abbruch - das Makro brauchte über 1 Minute Laufzeit !"
Exit Sub
End If
Next
Next
Next
Next
'V. Berechnung 5 möglicher Scheckkombinationen
'---------------------------------------------
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
msgbox "Gefunden: " & Chr(10) & Werte.Cells(a) & " + " &
Werte.Cells(b) & " + " & _
Werte.Cells(c) & " + " & Werte.Cells(d) & " + " &
Werte.Cells(e) & " = " & Gesucht & Chr(10) & "(Zelle " &
Werte.Cells(a).Address(False, False) _
& " + Zelle " & Werte.Cells(b).Address(False, False) & " +
Zelle " & _
Werte.Cells(c).Address(False, False) & " + Zelle " &
Werte.Cells(d).Address(False, False) & " + Zelle " &
Werte.Cells(e).Address(False, False) & ")." & Chr(10) & "Das Berechnen
dauerte " & _
Application.Round((Timer - Startzeit), 1) & " Sekunden."
Exit Sub
End If
If Timer - Startzeit > 60 Then
msgbox "Abbruch - das Makro brauchte über 1 Minute Laufzeit !"
Exit Sub
End If
Next
Next
Next
Next
Next
'VI. Meldung, falls keine Übereinstimmung erreicht
'-------------------------------------------------
msgbox "Keine Kombination für den Wert " & Gesucht & " gefunden." &
Chr(13) & "Das Berechnen von " & Kombinationen & " Kombinationen dauerte
" & Application.Round((Timer - Startzeit), 1) & " Sekunden."
Ende:
Range("A1").Activate
End Sub
Kohki SAITO schrieb in Nachricht <78iuit$kom$1...@unlisys.unlisys.net>...
Kohki SAITO
Ich danke Dir recht herzlich und probier das Macro bald aus.
JA
Gruß an Dich und die 'Exceljaner'
;-)
Bernd Bertels schrieb in Nachricht ...
>Hallo Kohki !
>
>Die eigentliche Lösung auf Deine Frage hab zwar nicht, aber ...
Kohki SAITO
Danke nochmals.
Martin Beck
ohne jetzt im Detail auf Dein Makro einzugehen, gibt es einige
Möglichkeiten, die Performance durch eine verbesserte Organisation der Daten
zu optimieren.
Ich würde mir eine leere "Hilfstabelle" anlegen, aus der ich auf das
"Original" zugreife, um folgende Schritte durchzuführen:
1. Vermeiden, daß Werte, die mehrfach vorkommen, auch mehrfach geprüft und
als Summanden ausgewiesen werden.
2. Werte, die größer als der Zielwert "Gesucht" sind, sollten gar nicht
überprüft werden, das sie ja logischerweise als Summanden nicht in Frage
kommen.
3. Die übriggebliebenen Werte sollten aufsteigend sortiert werden. Da die
Wahrscheinlichkeit, das eine kleine Zahl Summand wird, größer ist als für
eine große Zahl, werden so die Lösungen schneller gefunden.
4. Die äußere Schleife sollte nicht bis Werte.Cells.Count, sondern nur bis
Werte.Cells.Count dividiert durch die Zahl der Summanden (2, 3, 4, 5)
laufen. Aufsteigende Sortierung vorausgesetzt ergeben nämlich ab diesem
Grenzwert alle weiteren Kombinationsmöglichkeiten zwingend Ergebnisse größer
als "Gesucht". Sie brauchen daher nicht berücksichtigt zu werden.
5. Auch die inneren Schleifen brauchen nicht bis "zum bitteren Ende"
durchlaufen zu werden, sondern können (wiederum aufsteigende Sortierung
vorausgesetzt) dann abgebrochen werden, wenn "Gesucht" überschritten wird,
weil danach ja in dieser Schleife nur noch größere Ergebnisse kommen können.
Ich hoffe, das war einigermaßen verständlich und hilfreich. Nachfolgend ein
Makro, in das Du Dein Makro einbetten kannst, und das aus der "Hilfstabelle"
heraus gestartet werden muß. Siehe im einzelnen die Kommentarzeilen. Die von
mir gewählten Bezeichnungen weichen z.T. von Deinen ab, mußt Du eben
entsprechend anpassen.
Gruß
Martin Beck
Sub Summanden_finden()
'Eingabe des Suchwerts.
Suchwert = CDbl(InputBox("Eingabe des Suchwertes:"))
AnzSum = CDbl(InputBox("Eingabe der Zahl der Summanden:"))
'Jetzt werden Summanden ausgeschlossen, die mehrfach
'vorkommen oder größer als der Suchwert sind.
Columns("A:D").ClearContents
Worksheets("Hilfstabelle").Range("C1") = Worksheets("Original").Range("A1")
Worksheets("Hilfstabelle").Range("C2").Value = "<" & Suchwert & ""
Sheets("Original").Columns("A:A").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("C1:C2"), CopyToRange:=Range("A1"), Unique _
:=True
'Die Summanden werden aufsteigend sortiert.
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
'Hier das ursprüngliche Makro einfügen
' Außere Schleife sollte nur bis zum Summanden
' "Suchwert/Anzahl der Summanden" durchlaufen werden.
'For i =2 To Z
'If Cells(i, 1).Value > Suchwert/AnzSum Then
'Exit Sub
'Else
'Abbruchkriterien ergänzen:
'Wenn in einer Schleife der Vergleichswert genau erreicht oder
'überschritten wird, kann diese Schleife abgebrochen werden.
'Es erfolgt dann unmittelbar eine "Erhöhung" des Zählers in der
'nächsthöheren Schleife.
End Sub
Bernd Bertels schrieb in Nachricht ...
<snip>
>Ich geb' zu, daß das Makro ziemlich lang wurde, mitunter auch durch
>kleine Ergänzungen, die ich den Meldungsfenstern mitgeben wollte.
>
>Aber vielleicht wissen die anderen Newsgroup-Teilnehmer, wie man das
>Problem mit einer For-To-Schleife o.ä. verkürzen kann und auf alle
>Variablen als Summanden anwenden kann. Problematisch wird's irgendwann
>wahrscheinlich mit der Rechenzeit: Excel rechnet sich dumm & dämmlich,
>bis es zur eventuellen Lösung kommt.
>Jedenfalls wird's immer komplizierter !
>
Bernd Bertels
Vielen Dank für Deine weitere Unterstützung.
Ich schau mir's mal an (Du auch, Kohki ?).
Falls ich noch Fragen haben sollte, melde ich mich wieder
Ciao, Bernd.
Martin Beck schrieb in Nachricht <78nk5p$pjv$1...@news.metronet.de>...
>Hallo Bernd,
>ohne jetzt im Detail auf Dein Makro einzugehen, gibt es einige
>Möglichkeiten, die Performance durch eine verbesserte Organisation der
Daten
>zu optimieren. .....
>
>Gruß
>Martin Beck