Welche Summanden bilden vorgegebene Summe?

Question

Hallo,

ich habe eine Zahlenreihe und möchte ermitteln welche Summanden aus dieser Reihe eine vorgegebene Summe 272,29 bilden (ggf. mehrere Möglichkeiten). Z.Bsp:

[list]A 15,00 272,29
B 17,85
C 17,85
D 107,10
E 96,99
F 46,00
G 98,00
H 64,00
I 180,00
J 35,50
K 51,00
L 38,50
M 90,00
N 30,00
O 38,00
P 56,00
Q 16,66
R 15,00
S 35,50
T 50,00
U 55,93
V 126,00
W 120,00
X 51,00
Y 51,00
Z 42,00
AA 115,50
AB 30,35
A 67,00
C 75,00
AD 42,25
AE 62,48
AF 52,00
AG 107,10
AH 55,00
AI 294,53
2446,09
[/list]
Ich kann mir eigentlich nur ineinander geschachtelte Schleifen vorstellen die alle Kombinationen prüfen müssten, was allerdings sehr schnell einen erheblichen Aufwand bedeutet. Hat jemand einen guten Tipp wie man die Sache angehen könnte?
Danke und Gruß A.

Answer 1

hi Andreas ^^

liegt an der Deklaration der variablen,ich schau da nochmal

gruss nighty

Answer 2

hi Andreas ^^

hast recht ,nur ganze zahlen :-)
war mir gar nicht so bewusst ^^
ich bin auch der schlechteste tester von allen O_o
ich schreib das die tage um .-)

gruss nighty

Answer 3

Hallo nighty,

ich finde deinen Lösung bis hierher trotzdem schon prima!! Tolle Übersicht und gute Laufleistung. Guten Rutsch!
Gruß A.

Answer 4

hi Andreas und all ^^

mit kommastellen !
teste mal :-)

gruss nighty

Sub Summanten()
Range("B:C").Clear
Dim Lzeile As Long, BinZahl As Long, BinärIndex As Long
Dim BitIndex As Long, ZeilenIndex As Long, Zrng As Long
Dim Puffer As Double
Dim Puffer1 As String
Lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
ReDim daten(0 To 1, 1 To Lzeile) As Double
ReDim bdat(1 To 2 ^ Lzeile) As String
For Zrng = 1 To Lzeile
daten(1, Zrng) = Cells(Zrng + 1, 1)
Next Zrng
For BinZahl = 1 To 2 ^ Lzeile
bdat(BinZahl) = dec2bin(BinZahl)
If Len(bdat(BinZahl)) < Lzeile Then
For Zrng = 1 To Lzeile - Len(bdat(BinZahl))
bdat(BinZahl) = "0" & bdat(BinZahl)
Next Zrng
End If
Next BinZahl
For BinärIndex = 1 To 2 ^ Lzeile
For BitIndex = 1 To Lzeile
Puffer = Puffer + daten(Mid(bdat(BinärIndex), BitIndex, 1), BitIndex)
If daten(Mid(bdat(BinärIndex), BitIndex, 1), BitIndex) <> "0" Then Puffer1 = Puffer1 & " " & daten(Mid(bdat(BinärIndex), BitIndex, 1), BitIndex)
Next BitIndex
'Die gewünschte gesamtsumme,zur zeit die 4
If Puffer = 4 Then
ZeilenIndex = ZeilenIndex + 1
Cells(ZeilenIndex, 2) = Puffer
Cells(ZeilenIndex, 3) = Puffer1
End If
Puffer = 0
Puffer1 = ""
Next BinärIndex
End Sub

Function dec2bin(ByVal lngZahl As Long) As String
If lngZahl > 0 Then dec2bin = dec2bin(lngZahl \ 2) & IIf(lngZahl Mod 2, "1", "0")
End Function

Answer 5

Hallo nighty,

ich kriege in der Zeile

ReDim bdat(1 To 2 ^ Lzeile) As String

noch einen "Überlauf"-Fehler Habe es mal mit "Long" anstelle "String" probiert, klappte aber auch nicht....
Gruß A.

Answer 6

hi Andreas ^^

andere variante
spart speicher

gruss nighty

Sub Summanten()
Range("B:C").Clear
Dim Lzeile As Long, BinZahl As Long, BinärIndex As Long
Dim BitIndex As Long, ZeilenIndex As Long, Zrng As Long
Dim Puffer As Double
Dim Puffer1 As String, bdat As String
Lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
ReDim daten(0 To 1, 1 To Lzeile) As Double
For Zrng = 1 To Lzeile
daten(1, Zrng) = Cells(Zrng + 1, 1)
Next Zrng
For BinärIndex = 1 To 2 ^ Lzeile
bdat = dec2bin(BinärIndex)
If Len(bdat) < Lzeile Then
For Zrng = 1 To Lzeile - Len(bdat)
bdat = "0" & bdat
Next Zrng
End If
For BitIndex = 1 To Lzeile
Puffer = Puffer + daten(Mid(bdat, BitIndex, 1), BitIndex)
If daten(Mid(bdat, BitIndex, 1), BitIndex) <> "0" Then Puffer1 = Puffer1 & " " & daten(Mid(bdat, BitIndex, 1), BitIndex)
Next BitIndex
'Die gewünschte gesamtsumme,zur zeit die 4
If Puffer = 44 Then
ZeilenIndex = ZeilenIndex + 1
Cells(ZeilenIndex, 2) = Puffer
Cells(ZeilenIndex, 3) = Puffer1
End If
Puffer = 0
Puffer1 = ""
Next BinärIndex
End Sub

Function dec2bin(ByVal lngZahl As Long) As String
If lngZahl > 0 Then dec2bin = dec2bin(lngZahl \ 2) & IIf(lngZahl Mod 2, "1", "0")
End Function

Answer 7

Hallo nighty,

der Fehler kommt bei

For BinärIndex = 1 To 2 ^ Lzeile

:"Überlauf".

Mein Testbeispiel hat 37 Werte. Die gesuchte Lösung besteht aus 5 Summanden. Nach meiner Berechnung gibt es mit diesen Bedingungen insgesamt 435897 mögliche Kombinationen (Binärkoeffizient). Allerdings sind dabei auch die Kombinationen dabei, bei deren Summe die Zielsumme überschritten wird. Ich habe noch nicht verstanden wieviel Speicher du "vorhältst"..
Gruß A.

Answer 8

hi Andreas ^^

ich ueberarbeite das nochmal,dachte auch schon das es in diese Richtung geht

gruss nighty

Answer 9

hi Andreas ^^

probier mal

ersetzen(in der dritten zeile)
,BinärIndex As Long

durch eine neue zeile
Dim BinärIndex As Double

duerftr nur kurzfristig helfen

ich probiere noch die großen felder zu beseitigen

gruss nighty

Answer 10

Hallo nighty,

hab's versucht, reicht aber noch nicht.... du bist aber schon ganz nah dran!!!!!!
Gruß A.