AW: Bestmögliche Kombination bilden
07.10.2016 16:24:52
Michael
Hi,
jetzt bastel ich schon die ganze Zeit, dabei hat Bernd auch schon was gemacht.
Macht nix. Hier meine Variante, die auf einem Code von Daniel zur Kombinatorik fußt (link im Skript):
Sub Kombinatorik()
Dim x&, i&, z& ' & = as long
Dim a, b ' als Variant bzw. Array
Dim s#, bestS# ' as double
Dim AnzahlVariablen&, AnzahlKombinationen&
Dim ziel#, zDelta#
Dim schonDa As Boolean
a = Range("B2:B14") ' hier ggf. dynamisch
b = a
AnzahlVariablen = UBound(a)
AnzahlKombinationen = 2 ^ AnzahlVariablen
ziel = Range("G1")
zDelta = ziel * 0.95 ' ab 5% unter Ziel
Range("L2").CurrentRegion.ClearContents
Range("L2").Resize(AnzahlVariablen) = a
z = 1
For i = 0 To AnzahlKombinationen - 1
s = 0
For x = 0 To AnzahlVariablen - 1
b(x + 1, 1) = (-((i And (2 ^ x)) > 0)) * a(x + 1, 1)
s = s + b(x + 1, 1)
' Falls das "erstbeste" passende Ergebnis gewünscht ***
' If s zDelta And s > bestS Then
' Range("L2").Offset(, z).Resize(AnzahlVariablen) = b
' If s = ziel Then
' Range("D2").Resize(AnzahlVariablen) = b
' Exit Sub
' End If
' bestS = s
' Range("L1").Offset(, z).Value = s
' z = z + 1
' End If
' Falls eines aus mehreren passendes Ergebnis gewünscht ***
If (s zDelta And s > bestS) Or _
s = ziel Then
Range("L2").Offset(, z).Resize(AnzahlVariablen) = b
Range("L1").Offset(, z).Value = s
If s = ziel And (Not schonDa) Then
Range("D2").Resize(AnzahlVariablen) = b
schonDa = True
End If
bestS = s
z = z + 1
End If
Next
' If i Mod 1000 = 0 Then Stop ' bei sehr großer Anzahl evtl.
' mit ProgressBar garnieren oder so...
Next
' optischer Schnickschnack ...
With Range("L2").CurrentRegion
.HorizontalAlignment = xlCenter
.Rows(1).Interior.ColorIndex = 15
.Rows(1).Font.Bold = True
.Columns(1).Interior.ColorIndex = 15
.Columns(1).Font.Bold = True
End With
End Sub
Datei: https://www.herber.de/bbs/user/108653.xlsm
Das Makro gibt je nach dem, welchen Codeteil Du auskommentierst, "nur" den erstbesten Treffer aus oder (das ist der jetzt NICHT auskommentierte Teil) sowohl den erstbesten als auch alle weiteren, rechts, ab Spalte L (das ist eine Wiederholung der Werte aus Spalte B) bzw. Spalte M.
Viel Spaß,
Michael