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
@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
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, 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
Hi Julian,
habe das Bsp. von @Ego mal etwas mehr an dein Vorhaben angepasst. Testen und evtl. noch nachbessern.
[
attachment=20641]
Gruß Elex