In Excel eine Rechnung durch Annährung lösen?

... komplette Frage anzeigen

3 Antworten

Ich habe mir mal VBA-Funktionen hierfür gebastelt. Das sollte hoffentlich klappen. 

Die Suche nach Kombinationen sind meistens nicht mathematisch zu lösen, ohne alle Kombinationen durchzuspielen, also Algorithmen mit hoher Komplexität.

Public Function FindeSummanden(oBereich As Range, iSumme As Integer) As String
  '
  ' Findet die Summanden, die zu einer Summe führen
  '
  ' 29.05.2012 TH
  '
  Dim iaOriginalwerte()
  Dim i
  Dim oZelle

ReDim iaOriginalwerte(1 To oBereich.Cells.Count)
' Ich habe Arrays lieber i = 1 For Each oZelle In oBereich iaOriginalwerte(i) = oZelle.Value i = i + 1 Next
FindeSummanden = FindeSummandenIntern(iaOriginalwerte, iSumme) End Function
Private Function FindeSummandenIntern(iaSummanden, iSumme) As String Dim i Dim iSumTemp Dim iaTemp()
'debug'Call ArrayPrint(iaSummanden) FindeSummandenIntern = "Nicht gefunden"
For i = LBound(iaSummanden) To UBound(iaSummanden) If FindeSummandenIntern = "Nicht gefunden" Then iSumTemp = ArraySum(iaSummanden) If iSumTemp = iSumme Then FindeSummandenIntern = ArrayPrint(iaSummanden) Else If iSumTemp > iSumme Then iaTemp = iaSummanden Call ArrayRemoveElement(iaTemp, i) FindeSummandenIntern = FindeSummandenIntern(iaTemp, iSumme) End If End If End If Next End Function Private Sub ArrayRemoveElement(varArray, iPosToRemove)
' Löscht ein Arrayelement an einer bestimmten Position
Dim i, j
Dim varArrayNew()

If (iPosToRemove >= LBound(varArray)) And _
(iPosToRemove <= UBound(varArray)) Then

ReDim varArrayNew(LBound(varArray) To UBound(varArray) - 1)
j = LBound(varArrayNew)
For i = LBound(varArray) To UBound(varArray)
If i <> iPosToRemove Then
varArrayNew(j) = varArray(i)
j = j + 1
End If
Next

varArray = varArrayNew
End If
End Sub Private Function ArraySum(nArray) As Variant
' Summiert die Werte eines numerischen Arrays

Dim i

ArraySum = 0
For i = LBound(nArray) To UBound(nArray)
ArraySum = ArraySum + nArray(i)
Next
End Function Private Function ArrayPrint(varArray) As String
'Gibt den Arrayinhalt ins Debugfenster aus

Dim sDebug
Dim i

ArrayPrint = ""
For i = LBound(varArray) To UBound(varArray)
ArrayPrint = ArrayPrint & varArray(i) & ", "
Next
If Right(ArrayPrint, 2) = ", " Then _
ArrayPrint = Mid(ArrayPrint, 1, Len(ArrayPrint) - 2)
'debug' ArrayPrint = ArrayPrint & "Summe: " & ArraySum(varArray)

Debug.Print ArrayPrint
End Function
Antwort bewerten Vielen Dank für Deine Bewertung
Kommentar von Suboptimierer
09.03.2016, 11:10

Wenn etwas fehlt, gib Bescheid.

0

Wenn du eh ein bissl programmieren kannst dann nutze doch die eingebauten Entwicklertools von Excel und baue eine Schleife in einem VBA Progrämmchen in dem du mit einer Variable das günstigste Ergebnis speicherst und in einer oder mehreren Schleifen die Kombinationen durchgehst. Quellcode hab ich jetzt leider keinen.

Antwort bewerten Vielen Dank für Deine Bewertung

Es gibt in Excel den "Solver", der solche Aufgaben löst.
Google am besten mal nach "Excel Solver", da wirst Du einiges finden.
Ist aber meiner Erfahrung nach mit "Vorsicht zu genießen" und auch keine vollautomatische Lösung.
Für solche Aufgaben gibt es wahrscheinlich außerhalb von Excel bessere Lösungen. Da kann ich allerdings nicht weiterhelfen.


Antwort bewerten Vielen Dank für Deine Bewertung