vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Excel   |   VB-Versionen: VBA12.07.05
Newtonsches Näherungsverfahren

In manchen Fällen benötigt man die Nullstelle oder das Minimum einer Funktion die in einer Zelle in einem Excelblatt steht...

Autor:   Markus C. MüllerBewertung:     [ Jetzt bewerten ]Views:  21.631 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11kein Beispielprojekt 

In manchen Fällen benötigt man die Nullstelle oder das Minimum einer Funktion, die in einer Zelle in einem Excelblatt steht. Es gibt eine Zielfunktion z.B. x^2-1, wobei der Wert der Variablen x in einer extra Zelle steht. Es besteht die Möglichkeit den Solver von Excel zu verwenden. Die andere Möglichkeit besteht darin, wenn nur eine Variable optimiert werden soll, das newtonsche Näherungsverfahren zu benutzen.

Sub Aufrufen()
  Dim Konvergiert As Boolean
 
  ' In der Zelle A1 steht der X Wert der Funktion
  ' In der Zelle B1 steht die noch unbekannte Funktion z.B. x^2-1. 
  ' Zum nachvollziehen in der Zelle B1 steht A1^2-1
  ' Bitte beachten: es wird nur eine Nullstelle gefunden. 
  ' Je nach Startwert ist entweder ca. -1 oder ca. +1 die Lösung
  ' Diese Prozedur ist nur zum Aufrufen gedacht und hat keine weitere Bedeutung
 
  Konvergiert = Newton("A1", "B1")
End Sub
Function Newton(VeränderbareZelle As String, Zielzelle As String) As Boolean
  Dim i As Integer
  Dim Startwertx As Double
  Dim Startwerty As Double
  Dim Werty As Double
  Dim delta As Double
  Dim Steigung As Double
 
  Do
    ' Zähler um Schleife bei Divergenz zu verlassen
    i = i + 1
 
    ' Delta steht für die Schrittweite um die Ableitung an der Stelle zu finden
    delta = 0.00000001
 
    ' Startwert wird übergeben
    Startwertx = Range(VeränderbareZelle).Value
 
    ' Y Wert wird übergeben
    Startwerty = Range(Zielzelle).Value
 
    ' Der x Wert wird um ein Delta erhöht um Ableitung bilden zu können
    Range(VeränderbareZelle).Value = Range(VeränderbareZelle).Value + delta
 
    ' Y Zelle wird verändert
    Werty = Range(Zielzelle).Value
 
    ' Aus dem Startwert und dem Deltawert wird die Steigung bestimmt
    Steigung = (Werty - Startwerty) / delta
 
    ' Der neue X Wert wird bestimmt
    Range(VeränderbareZelle).Value = Range(VeränderbareZelle).Value - Startwerty / Steigung
    ' 0.00000000001 ist die Abbruchbedingung oder wenn i>100,
    ' da es Fälle gibt bei dem das Verfahren divergiert
  Loop Until Abs(Range(Zielzelle).Value - Startwerty) < 0.00000000001 Or i > 100
 
  ' Falls mehr als 100 Iterationen durchgeführt werden mussten hat die Funktion keine 
  ' Nullstelle bzw. divergiert mit dem Startwert
  ' Es muss ein besserer Startwert gewählt werden. Die Zahl 100 ist natürlich vollkommen 
  ' willkürlich 20 ist meist schon ausreichend.
  If i > 100 Then
    Newton = False
  Else
    Newton = True
  End If
End Function

Dieser Tipp wurde bereits 21.631 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel