Berechnung maximaler Betrag unter Bedingung

[julian__]

Hallo zusammen,

ich stehe gerade etwas auf dem Schlauch ;)

Ich möchte aus einer Zahlenreihe z.B. {22,40;6,40;16,50;57,65;15,75;2,80;11,00;3,99} den maximalen Betrag bis 50 errechnen.

Hat jemand eine Idee, wie die Funktion hierfür aussehen könnte?

Lg und danke für eure Hilfe,

Julian

[Frogger1986]

Arbeitsblatt mit dem Namen 'Tabelle1'
	B	C	D	E	F	G	H	I	J	K
4	22,4	6,4	50	57,65	15,75	2,8	11	3,99		57,65

Zelle	Formel
K4	=KGRÖSSTE(B4:I4;1)

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

[MisterBurns]

@Frogger: Der Wert, der gesucht ist, soll <=50 sein

Tabelle1

	A	B
1	22,4	22,4
2	6,4
3	16,5
4	57,65
5	15,75
6	2,8
7	11
8	3,99

Formeln der Tabelle

Zelle Formel B1 {=MAX(WENN(A1:A8<=50;A1:A8;0))}

Enthält Matrixformel: Umrandende { } nicht miteingeben, sondern Formel mit STRG+SHIFT+RETURN abschließen!

Matrix verstehen

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

[julian__]

Danke euch für eure Hilfe!

@MisterBurns auch nicht ganz, aber etwas ungenau von mir oben erklärt.

Ziel ist es innerhalb der Zahlenreihe die Kombination in Summe der Zahlen zu finden, die am nähesten an 50 sind.

Beispiel:
22,40 + 16,50 + 6,40 + 3,99  = 49,29
6,40 + 16,50 + 15,75  + 11,00 = 49,65 <- ist näher an 50

Dementsprechend die verschiedenen Möglichkeiten durchgehen und den Betrag mit der höchsten Summe <=50 ausgeben.

[Elex]

Hi

Hier findest du Vorlagen die du an dein Problem anpassen kannst.
https://www.clever-excel-forum.de/thread-16459.html
Wenn es selbst nicht klappt mit anpassen, einfach nachfragen.

Gruß Elex

[julian__]

@Elex, danke dir

Ich komme nicht wirklich weiter.

Ich habe im unteren Code zwei Zeilen abgeändert:

If dblAktWert < dblSuchWert Then

If dblAktWert < dblSuchWert Then

Problem was ich gerade auch noch sehe ist, dass lngEbenen (Anzahl der Werte pro Kombination) unterschiedlich sein kann. Das wird dann aber out of space in der Lösung oder?

Original:

Code:

Option Explicit

Dim lngOffset As Long
Dim lngAnzwerte As Long
Dim dblAktWert  As Double
Dim dblSuchWert As Double
Dim dblKombinationen() As Double
Dim varListe As Variant
Dim rngAusgabe As Range
Const lngEbenen As Long = 4
Const dblAbweichung As Double = 0.006


Sub Machs()
varListe = ThisWorkbook.Names("Liste").RefersToRange.Value
dblSuchWert = ThisWorkbook.Names("Suchwert").RefersToRange.Value
Set rngAusgabe = ThisWorkbook.Names("Ausgabe").RefersToRange
ReDim dblKombinationen(1 To lngEbenen)

lngAnzwerte = UBound(varListe, 1)
lngOffset = 0
dblAktWert = 0
rngAusgabe.CurrentRegion = ""

If lngAnzwerte > 0 Then
   Call Recursiv(1, 1)
End If
MsgBox lngOffset & " Kombinationen gefunden."
End Sub
Sub Recursiv(ByVal lngEbene As Long, ByVal lngPos As Long)
Dim lngPosIntern As Long
Dim lngSpalte  As Long
   If lngPos <= lngAnzwerte And lngEbene <= lngEbenen Then
       For lngPosIntern = lngPos To lngAnzwerte
           dblAktWert = dblAktWert + varListe(lngPosIntern, 1)
           dblKombinationen(lngEbene) = varListe(lngPosIntern, 1)
           If Abs(dblAktWert - dblSuchWert) < dblAbweichung Then
               For lngSpalte = 1 To lngEbene
                   rngAusgabe.Offset(lngOffset, lngSpalte - 1) = dblKombinationen(lngSpalte)
               Next lngSpalte
               
               lngOffset = lngOffset + 1
           End If
           If dblAktWert < dblSuchWert + dblAbweichung Then
               Call Recursiv(lngEbene + 1, lngPosIntern + 1)
           End If
           dblAktWert = dblAktWert - varListe(lngPosIntern, 1)
       Next lngPosIntern
   End If
End Sub

Bearbeitet:

Code:

Option Explicit

Dim lngOffset As Long
Dim lngAnzwerte As Long
Dim dblAktWert  As Double
Dim dblSuchWert As Double
Dim dblKombinationen() As Double
Dim varListe As Variant
Dim rngAusgabe As Range
Const lngEbenen As Long = 4
Const dblAbweichung As Double = 0.006


Sub Machs()
varListe = ThisWorkbook.Names("Liste").RefersToRange.Value
dblSuchWert = ThisWorkbook.Names("Suchwert").RefersToRange.Value
Set rngAusgabe = ThisWorkbook.Names("Ausgabe").RefersToRange
ReDim dblKombinationen(1 To lngEbenen)

lngAnzwerte = UBound(varListe, 1)
lngOffset = 0
dblAktWert = 0
rngAusgabe.CurrentRegion = ""

If lngAnzwerte > 0 Then
   Call Recursiv(1, 1)
End If
MsgBox lngOffset & " Kombinationen gefunden."
End Sub
Sub Recursiv(ByVal lngEbene As Long, ByVal lngPos As Long)
Dim lngPosIntern As Long
Dim lngSpalte  As Long
   If lngPos <= lngAnzwerte And lngEbene <= lngEbenen Then
       For lngPosIntern = lngPos To lngAnzwerte
           dblAktWert = dblAktWert + varListe(lngPosIntern, 1)
           dblKombinationen(lngEbene) = varListe(lngPosIntern, 1)
           If dblAktWert < dblSuchWert Then                                 '<- geändert
               For lngSpalte = 1 To lngEbene
                   rngAusgabe.Offset(lngOffset, lngSpalte - 1) = dblKombinationen(lngSpalte)
               Next lngSpalte
               
               lngOffset = lngOffset + 1
           End If
           If dblAktWert < dblSuchWert Then                                 '<- geändert
               Call Recursiv(lngEbene + 1, lngPosIntern + 1)
           End If
           dblAktWert = dblAktWert - varListe(lngPosIntern, 1)
       Next lngPosIntern
   End If
End Sub

[Elex]

Hi Julian,

habe das Bsp. von @Ego mal etwas mehr an dein Vorhaben angepasst. Testen und evtl. noch nachbessern.


  Summen Frage.xlsm (Größe: 31,98 KB / Downloads: 7)

Gruß Elex