Microsoft Excel

Herbers Excel/VBA-Archiv

Zielwertsuche über VBA ....

Betrifft: Zielwertsuche über VBA .... von: proxima05
Geschrieben am: 13.02.2007 08:16:20

Hallo,

ich möchte eine Zielwertsuche (Z.) über VBA realisieren ... für diese habe ich drei Zellen:

A1 = Zielwert
A2 = Formel (die mit dem Wert aus A3 rechnet)
A3 = Veränderbare Zelle

Gibt es die Möglichkeit, dass die Z. ausschliesslich in VBA abläuft und der Wert aus A3 sowie das Ergebnis aus A2 an eine andere Formel übergeben wird, die dann den Endwert in eine Tabellenzelle übergibt? ... ich stelle mir vor, dass bestimmte Ergebnisse in VBA zwischengespeichert und an nachfolgend startende Aktionen übergeben werden. Gestartet werden soll die Z., wenn eine bestimmte Tabellenzelle mit einem Eintrag gefüllt wird.

Geht so etwas? .... danke für einen Tipp.

Gruß

Ralph

  


Betrifft: AW: Zielwertsuche über VBA .... von: ingUR
Geschrieben am: 14.02.2007 03:58:52

Hallo, Ralph,

wo liegt das Problem? So wie ich Deine Aufgabe verstehe läuft es doch nur darauf hinaus, den "Solver" nachzubilden, also die Schleife für den Inhalt der "Veränderlichen" festzulegen und zu prüfen, ob mit dem Formelergebnis eine gewünscht Genauigkeit zum Zielwert erreicht wird. In dieser Schleife kannst du dann jeden Zwischenwert zusätzlich einer Auswertung unterziehen.

Option Explicit

Sub Zielwertsuche()
    Dim maxIterationen As Long, nIteration As Long
    Dim Genauigkeit As Double
    Dim delta As Double, prevD As Double, d As Double

    maxIterationen = 100
    Genauigkeit = 0.00000001
    delta = Range("A1")

    Do
        Range("A3") = Range("A3") + delta
        ' mit dem neuen Inhalt von Telle A3 wird die Formel in A2 berechnet
        ' der Zellenwert von A2 wird nun mit A1 verglichen
        d = Abs(Range("A1") - Range("A2"))
        
        Cells(10 + nIteration, 1) = nIteration
        Cells(10 + nIteration, 2) = delta
        Cells(10 + nIteration, 3) = d
        Cells(10 + nIteration, 4) = Range("A3") 'Veränderlich
        Cells(10 + nIteration, 5) = Range("A2") 'Zielwertannäherung

                
        If d < Genauigkeit Then
            Exit Do
        Else
            If prevD < d Then
                'Differenz hat sich vergrößert
                delta = -delta / 2
            End If
        End If
        nIteration = nIteration + 1
        prevD = d
    Loop Until nIteration = maxIterationen
    
    Range("A5") = nIteration
    If nIteration = maxIterationen Then
        'mit maxIterationesschritten ist die gewünscht Genauigkeit nicht erreicht
        Exit Sub
    End If
End Sub
Natürlich soll mit diesem Algorithmus nur das Prinzip der schrittweisen Näherung und die Möglichkeit der Weiterverabeitung der Schrittergebnisse demonstiert werden, ohne dass auf ein sinnvolles Beispiel mit effektivem Lösungsansatz gezielt wird.

https://www.herber.de/bbs/user/40411.xls

Gruß,
Uwe


 

Beiträge aus den Excel-Beispielen zum Thema "Zielwertsuche über VBA ...."