Registriert seit: 08.11.2018
Version(en): Mac
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
Registriert seit: 02.12.2017
Version(en): Office 365
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 |
Eine Menge reden, aber nichts sagen können viele...
Registriert seit: 02.05.2018
Version(en): Excel 365 & 2016
@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
Schöne Grüße
Berni
Registriert seit: 08.11.2018
Version(en): Mac
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.
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
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
Registriert seit: 08.11.2018
Version(en): Mac
08.11.2018, 18:54
(Dieser Beitrag wurde zuletzt bearbeitet: 08.11.2018, 20:46 von WillWissen.
Bearbeitungsgrund: Formatierung
)
@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
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
08.11.2018, 21:12
(Dieser Beitrag wurde zuletzt bearbeitet: 08.11.2018, 21:12 von 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
|