mögliche Kombination für VORHANDENEN Mittelwert finden

26.03.2025 00:38:16

progression

Guten Abend für euch

Ich habe folgendes Problem:

Ich habe einen feststehenden Mittelwert und möchte herausfinden welche mögliche Zahlenkombination zu dem vorgegebenen Mittelwert führt

Beispiel: In Spalte A stehen folgende Zahlen:
10
8
4
9

Der vorgegebene Mittelwert beträgt 6

Excel soll mir jetzt anzeigen das die Summe aus 4 und 8 den Mitwelwert 6 ergeben.

Ich denke das hier mit dem Solver gearbeitet werden muss. Versuche ich mit dem Solver zu ermittweln welche Summe der vorgegebenen Zahlen 12 ergibt funktioniert das einwandfrei, mir werden die Zahlen 8 und 4 ausgegeben. Ich will jedoch KEINE mögliche Summe die zu einer Gesamtsumme führt errechnen lassen sondern Kobinationen herausfinden die zu einem gesuchten Mittelwert führen.

Kann wer helfen?

https://www.herber.de/bbs/user/176427.xlsx

Userbild

AW: mögliche Kombination für VORHANDENEN Mittelwert finden

26.03.2025 01:11:54

Onur

" mögliche Zahlenkombination" ? Aus wie vielen Zahlen denn?
Was hat die gepostete Datei mit dem Problem zu tun? Was soll sie uns zeigen, zumal sie ganz andere Zahlen enthält als deine Frage?

Kombination finden mit VBA + Funktion (O2016 + O365)

26.03.2025 09:09:59

MCO

Moin!
Mit Solver kenn ich mich nicht aus, daher hab ich mal den Ansatz VBA gewählt.

Lösung A
Werte werden im Direktbereich ausgegeben, kannst du in beliebige Zellen schreiben

Sub Mittelwerte()



    Dim rng As Range

    Dim cell As Range

    Dim wert_arr() As Variant

    Dim i As Integer

    Dim j As Integer

    

    ' Bereich mit konstanten Werten in Spalte A auswählen

    Set rng = Range("A:A").SpecialCells(xlCellTypeConstants)

    

    ' Array mit passender Größe initialisieren

    ReDim wert_arr(1 To rng.Cells.Count)

    

    ' Werte aus Range in 1D-Array übertragen

    i = 1

    For Each cell In rng

        wert_arr(i) = cell.Value

        i = i + 1

    Next cell

    

    ' Doppelte Schleife für Mittelwert-Berechnung

    For i = 1 To UBound(wert_arr) - 1

        For j = i + 1 To UBound(wert_arr)

            'Debug.Print i, wert_arr(i), j, wert_arr(j), (wert_arr(i) + wert_arr(j)) / 2

            m_wert = (wert_arr(i) + wert_arr(j)) / 2

            e_wert = (wert_arr(i) & "+" & wert_arr(j))

            If m_wert = 10 Then

                'werte = werte & IIf(werte > "", ";", "") & m_wert

                e_werte = e_werte & IIf(e_werte > "", ";", "") & e_wert

            End If

        Next j

    Next i

    Debug.Print werte

    Debug.Print e_werte

End Sub

Lösung B
O365: Eine Funktion, die die Parameter bekommt und die Wert entsprechend ausgibt:

-	A	E	G
1	5	Vorgabewert	10
2	15	Führn zum Vorgabewert	5+15	7+13	8+12	9+11
3	7
4	13
5	8
6	12
7	9
8	11
9	10
10	1
11	2
12	3
13	4
14	6

A	C	G
1	5	Vorgabewert	10
2	15	Führn zum Vorgabewert	=Kombination(A1:A14;D1)
3	7
4	13
5	8
6	12
7	9
8	11
9	10
10	1
11	2
12	3
13	4
14	6

Die Funktion dazu (mit freundlicher Unterstützung von ChatGPT)

Function Kombination(Zahlen As Range, Vorgabewert As Long) As Variant

    Dim wert_arr() As Variant

    Dim i As Integer, j As Integer

    Dim cell As Range

    Dim ergebnis As Collection

    Set ergebnis = New Collection

    

    ' Array mit passender Größe initialisieren

    ReDim wert_arr(1 To Zahlen.Cells.Count)

    

    ' Werte aus Range in 1D-Array übertragen

    i = 1

    For Each cell In Zahlen

        wert_arr(i) = cell.Value

        i = i + 1

    Next cell

    

    ' Doppelte Schleife für Mittelwert-Berechnung

    For i = 1 To UBound(wert_arr) - 1

        For j = i + 1 To UBound(wert_arr)

            If (wert_arr(i) + wert_arr(j)) / 2 = Vorgabewert Then

                ergebnis.Add wert_arr(i) & "+" & wert_arr(j)

            End If

        Next j

    Next i

    

    ' Rückgabe als Array

    If ergebnis.Count > 0 Then

        Kombination = ergebnisToArray(ergebnis)

    Else

        Kombination = Array() ' Leeres Array, falls keine Kombination gefunden wird

    End If

End Function



' Hilfsfunktion zur Umwandlung einer Collection in ein Array

Private Function ergebnisToArray(col As Collection) As Variant

    Dim arr() As Variant

    Dim i As Integer

    ReDim arr(1 To col.Count)

    

    For i = 1 To col.Count

        arr(i) = col.Item(i)

    Next i

    

    ergebnisToArray = arr

End Function

Lösung C
O2016
Erweiterung zu Lösung B, dabei werden die Werte in verschiedene Zellen geschrieben

Sub AusgabeKombination()

    Dim komb As String

    komb = Kombination(Range("A1:A10"), 10)

    

    Dim arr() As String

    Dim i As Integer

    Dim ws As Worksheet

    Set ws = ActiveSheet

    

    ' Ergebnis aufteilen und in Spalte C schreiben

    arr = Split(komb, "; ")

    For i = LBound(arr) To UBound(arr)

        ws.Cells(i + 1, 3).Value = arr(i)

    Next i

End Sub

Gruß, MCO

AW: Kombination finden mit VBA + Funktion (O2016 + O365)

26.03.2025 18:45:05

progression

Grüße dich, zunächst vielen Dank

Mit VBA kenne ich mich überhaupt nicht aus, ich weiß nicht einmal wo und wie ich deinen geschriebenen Code in Excel eingebenen soll

da ich Dussel wohl auch noch einige Informationen noch nicht gegeben habe trage ich folgendes nach:

1. Aus allen Zahlen möchte ich heraus finden ob es irgendeine Kombination gibt, die einen Mittelwert von 10 (nur Beispiel) ergibt. Aus wie vielen Kombinationen dieser Mittelwert gebildet wird ist egal und somit UNBEKANNT, Beispiel: 3+2+15+20 ergibt die Summe von 40, Mittelwert somit 10, eine 8+12 ergibt in Summe 20 und auch wiederum als Mittelwert 10. Theoretisch ist somit ja auch mehr als eine Kombination möglich.

2. Die Zahlen sowie der gesuchte Mittelwert sollten auch Dezimalzahlen sein können

3. Sollte es keine Kombination geben die exakt dem gesuchten Mittelwert entspricht, sollte der Code die am nahe kommenste Kombination anzeigen.

Im Anhang mal die Tabelle um die es wirklich geht

Gruß Didi

AW: Kombination finden mit VBA + Funktion (O2016 + O365)

27.03.2025 05:10:37

Onur

"Theoretisch ist somit ja auch mehr als eine Kombination möglich."
Theoretisch ist somit ja auch unendlich viele Kombinationen möglich.
8+12 ergibt einen Durchschnittswert von 10 - genauso wie 2x8 + 2x12 oder 3x8 + 3x12 oder 4x + 4x12 usw usw.
Deswegen meine unbeantwoertete Frage nach der Anzahl.....

Variante mit Iteration

26.03.2025 13:45:01

{Boris}

Hi,

anbei eine Variante mit Iteration. Dazu musst Du in den Exceloptionen - Formeln die Iteration aktivieren mit der max. Iterationszahl 1.
Den Zielwert gibst Du in der gelben Zelle ein. Darunter (unter Pool) gibst Du die zur Verfügung stehenden Zahlen ein (im Beispiel sind es max. 9 Zahlen).

https://www.herber.de/bbs/user/176438.xlsx

VG, Boris

AW: Variante mit Iteration

26.03.2025 19:11:17

progression

da ich Dussel wohl auch noch einige Informationen noch nicht gegeben habe trage ich folgendes nach:

1. Aus allen Zahlen möchte ich heraus finden ob es irgendeine Kombination gibt, die einen Mittelwert von 10 (nur Beispiel) ergibt. Aus wie vielen Kombinationen dieser Mittelwert gebildet wird ist egal und somit UNBEKANNT, Beispiel: 3+2+15+20 ergibt die Summe von 40, Mittelwert somit 10, eine 8+12 ergibt in Summe 20 und auch wiederum als Mittelwert 10. Theoretisch ist somit ja auch mehr als eine Kombination möglich.

2. Die Zahlen sowie der gesuchte Mittelwert sollten auch Dezimalzahlen sein können

3. Sollte es keine Kombination geben die exakt dem gesuchten Mittelwert entspricht, sollte der Code die am nahe kommenste Kombination anzeigen.

Hier mal meine originale Datei um die es tatsähclich geht

https://www.herber.de/bbs/user/176446.xlsx

Kannst du mir das bauen Boris?

AW: Variante mit Iteration

27.03.2025 14:48:26

progression

Hallo Boris, abermals vielen Dank für deine Beiträge...ich kenne mich einfach 0 aus mit BVA in Excel

ich hätte aber nochmals eine Frage zu deiner Iteration Variante was das "beste Zwischenergebnis angeht" Wie habe ich das zu deuten wenn das Zwischenergebnis anders ist als das Ergebnis, genauer gefragt...wie kann ich herausfinden aus welchen Zahlen das Zwischenergebnis errechnet wird?

Gruß Didi

AW: Variante mit Iteration

26.03.2025 21:10:35

Oppawinni

ouch... das gibt so grob..7 `* 10^22 Möglichkeiten, die zu prüfen wären.... das ist dann nicht ganz so trivial wie es aussah.
und dann... was heißt nahe kommen.. es kann auch da mehrere Lösungen geben, die ähnlich nahe liegen, aber halt nicht treffen.
Das macht die Sache jedenfalls jetzt nicht einfacher und natürlich dann auch nicht schneller....
Da halt ich mich jetzt besser raus...

AW: Variante mit Iteration

27.03.2025 08:44:35

Oppawinni

Also ich hab mein Programm etwas modifiziert, gestartet und die Nacht laufen lassen.
Nach 6 Stunden sind gerade mal etwa die Möglichkeiten der ersten 28 Werte abgeackert, die Möglichkeiten der ersten 29 in Arbeit.
Der Mittelwert aus den Werten 15;16;17;18;19;29 sollte demnach eine Abweichung vom Soll von 0,135 haben und das bisher beste Ergebnis darstellen.
Ich denke zwar, dass das Programm letztlich zielführend wäre, aber wer will das wirklich wochenlang laufen lassen?
Den Code will dann vermutlich auch keiner sehen, oder?

Mal anders...

27.03.2025 13:53:36

Oppawinni

Um überhaupt in einer vernüftigen Zeit ein Ergebnis zu bekommen hab ich das mal anders gemacht.
Zunächst aus allen der Mittelwert, dann immer einen Wert weniger, wenn die Wegnahme des Wertes ein bessere Näherung bringt.
Da gibt es natürlich nicht jede mögliche Lösung und inwieweit die Lösung dann optimal ist, ist eine andere Frage...
Dennoch:



Sub unit()

    

    Dim rngIn As Range, dblMean As Double

    Dim dblM As Double, dblMDif As Double, dblChg As Double

    Dim arrBol() As Boolean

    Dim arrIn As Variant

    Dim lngCnt As Long, lngDiv As Long, lngKill As Long

    Dim I As Long, j As Long

    Dim strOut As String

    Dim t

    

' hier den Range und den Mittelwert einstellen

' Ergebnisausgabe in Msgbox



    Set rngIn = Tabelle1.Range("A2:A77")

    dblMean = 5826.04

    

    arrIn = rngIn.Value

    lngCnt = UBound(arrIn)

    ReDim arrBol(1 To lngCnt)

    dblMDif = WorksheetFunction.Min(arrIn) - dblMean

    

    t = Timer

    

    For I = lngCnt To 1 Step -1

                

        For j = 1 To lngCnt

            If Not arrBol(j) Then

                dblM = dblM + arrIn(j, 1) / I

            End If

        Next

        

        lngKill = 0

        For j = 1 To lngCnt

            If Not arrBol(j) Then

                dblChg = dblM * (I / (I - 1) - 1) - arrIn(j, 1) / (I - 1)

                If Abs(dblM + dblChg - dblMean)  Abs(dblMDif) Then

                    lngKill = j

                    dblMDif = dblChg + dblM - dblMean

                End If

            End If

        Next

        

        If lngKill = 0 Then Exit For

        

        arrBol(lngKill) = True

        dblM = 0

        

    Next



    For j = 1 To lngCnt

        If Not arrBol(j) Then

            strOut = strOut & j & ";"

        End If

    Next



    strOut = Left(strOut, Len(strOut) - 1)

    t = Timer - t



    MsgBox "Der Mittelwert " & Format(dblM, "0.000") & " aus den Werten" & vbCr & strOut & vbCr _

         & "hat eine Abweichung von " & Format(dblMDif, "0.000") & vbCr & "vom gesuchten Mittelwert " & dblMean & vbCr _

         & "Die Berechnung dauerte " & Format(t, "0.00") & " Sekunden"



End Sub

Ergebnis:
Der Mittelwert 5826,068 aus den Werten
11;12;13;14;15;16;18;19;30;31;32;33;34;35;36;37;38;52;54;55;56;57;71;73;74;75;76
hat eine Abweichung von 0,028 vom gesuchten Mittelwert 5826,04

Ich hab das aber nicht überprüft :)

AW: Mal anders... mit Excelfile

27.03.2025 16:50:44

Oppawinni

Etwas benutzerfreundlicher, aber das war es dann für mich .. hoff ich.
Schlimm, wenn ich mal schreibe, dass ich nix mach....
https://www.herber.de/bbs/user/176468.xlsm

AW: mögliche Kombination für VORHANDENEN Mittelwert finden

26.03.2025 15:40:31

daniel

Hi
eine kleine Bitte:
um uns Helfern das Leben leichter zu machen, ist es immer hilfreich, wenn deine Problembeschreibung und die Beispieldatei zueinander passen.
das macht es leichter, dass beschriebene in der Datei wiederzufinden.
du schreibst jetz von den Zahlen 10, 8, 4 und 9.
im Bild und in der Datei finde ich aber ganz andere Zahlen. Woher weiß ich, dass es die richtigen sind?
das nächste Problem ist, wie soll ich dir die Lösung beschreiben? Mit den Werten, die in der Beschreibung stehen oder mit den Werten, aus der Beispieldatei?
daher bitte immer Beschreibung und Beispieldatei aufeinander abstimmen.

zur Lösung, hier mal der Brute-Force-Ansatz für maximal 20 Werte
1. schreibe die Zahlen in Zeile 1 in die Spalten A-E (oder was auch immer, je nach dem wie
viele Zahlen du hast)
2. in die Zeile 2 kommt unter diese Zahlen diese Formel (für A2):

=WENN(REST(QUOTIENT(ZEILE(A1);2^(SPALTE(A1)-1));2);A$1;"---")

diese Formel ziehst du nach rechts unter alle Zahlen und nach unten, soweit wie benötigt. Du hast im Beispiel 5 Zahlen, dann benötigst du die Formel bis Zeile 32 berechnet nach 2^5, bei 6 Zahlen müsstest du dann schon bis Zeile 64 (2^6)
über diesen Ansatz bekommst du eine Auflistung aller möglichen Kombinationen der genannten Zahlen
3. in der ersten freien Spalte neben den Daten berechnest du dann den Mittelwert dieser Zeile mit der Formel

=MITTELWERT(A2:E2)

4. filtere dann mit dem Autofilter in der Mittelwertsspalte nach dem gewünschten Mittelwert und du bekommst alle kombinationen angezeigt, die diesen Mittelwert ergeben.

Gruß Daniel

AW: mögliche Kombination für VORHANDENEN Mittelwert finden

26.03.2025 23:42:42

progression

vielen Dank Daniel

AW: mögliche Kombination für VORHANDENEN Mittelwert finden

26.03.2025 16:51:02

Oppawinni

Also ohne VBA Kenntnisse bringt das wahrscheinlich nicht viel.
Ich weiß auch nicht wie umfangreich die Wertetabelle sein kann und wie du dir die Ausgabe der Ergebnisse vorstellst.
Theoretisch könnte es ja mehrere mögliche Kombinationen geben, die zu dem gesuchten Mittelwert führen...
Ich hab da mal eben was zusammen geschossen, das könnte man ggf. auch zur Funktion umbauen.
Hab das jetzt aber auch nicht großartig getestet, zumal mir die Anforderungen nicht völlig klar sind.



Sub unit()

    

    Dim rngIn As Range, dblMean As Double

    Dim dblM As Double

    Dim arrIn As Variant

    Dim lngCnt As Long, lngDiv As Long

    Dim I As Long, j As Long, Z As Long

    Dim strFound As String, strOut As String



'  Hier den Wertebereich und den gesuchten Mittelwert einstellen

'  Das Ergebnis wird im Direktfenster ausgegeben

    Set rngIn = Tabelle1.Range("B6:B11")

    dblMean = 6#

    

    arrIn = rngIn.Value

    lngCnt = UBound(arrIn)

    

    I = 1

    Z = 2 ^ lngCnt - 1

    

    For I = 1 To Z

        strFound = ""

        lngDiv = 0

        dblM = 0#

        

        For j = 1 To lngCnt

            If (I And (2 ^ (j - 1))) > 0 Then

                lngDiv = lngDiv + 1

                dblM = dblM + Val(arrIn(j, 1))

                strFound = strFound & Val(arrIn(j, 1)) & ";"

            End If

        Next

        

        strFound = Left(strFound, Len(strFound) - 1)

        dblM = dblM / CDbl(lngDiv)

        

        If Abs(dblM - dblMean)  0.000000001 Then

            strOut = strOut & strFound & "|"

        End If

    

    Next

    

    If strOut > "" Then

       strOut = Left(strOut, Len(strOut) - 1)

       Debug.Print strOut

    End If

    

End Sub

AW: mögliche Kombination für VORHANDENEN Mittelwert finden

26.03.2025 17:46:33

Oppawinni

Doch noch eine kleine Korrektur, damit es bei mehr Werten und/oder größeren Werten nicht knallt...



Sub unit()

    

    Dim rngIn As Range, dblMean As Double

    Dim dblM As Double

    Dim arrIn As Variant

    Dim lngCnt As Long, lngDiv As Long

    Dim I As Long, j As Long, Z As Long

    Dim strFound As String, strOut As String



' Hier Range und Mittwert einstellen

' Ausgabe erfolgt per Messagebox   

    Set rngIn = Tabelle1.Range("B6:B11")

    dblMean = 6#

    

    arrIn = rngIn.Value

    lngCnt = UBound(arrIn)

    

    I = 1

    Z = (2 ^ lngCnt - 1)

    

    For I = 1 To Z

        strFound = ""

        lngDiv = 0

        dblM = 0#

        

        For j = 1 To lngCnt

            If (I And (2 ^ (j - 1))) > 0 Then

                lngDiv = lngDiv + 1

                dblM = dblM + (Val(arrIn(j, 1)) - dblM) / lngDiv

                strFound = strFound & Val(arrIn(j, 1)) & ";"

            End If

        Next

        

        strFound = Left(strFound, Len(strFound) - 1)

        

        If Abs(dblM - dblMean)  0.000000001 Then

            strOut = strOut & strFound & "|"

        End If

    

    Next

    

    If strOut > "" Then

       strOut = Left(strOut, Len(strOut) - 1)

       MsgBox strOut

    End If

    

End Sub

mögliche Kombination für VORHANDENEN Mittelwert finden

Forumthread: mögliche Kombination für VORHANDENEN Mittelwert finden

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

mögliche Kombination für VORHANDENEN Mittelwert finden

Forumthread: mögliche Kombination für VORHANDENEN Mittelwert finden

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread