Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
768to772
768to772
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Ausgleichspolynom

Ausgleichspolynom
05.06.2006 08:38:23
Sven
Hallo zusammen,
nach einiger Zeit benötige ich 'mal wieder Hilfe vom besten Forum der Welt rund um EXCEL.
Ich habe gerade ein Messdaten-Auswertungstool unter EXCEL programmiert. Hierfür benötige ich unter anderem ein Ausgleichspolnom 6ter Ordnung (vgl. Trendlinie). Leider komme ich da nicht um die Matrizenrechnung umhin, sodass meine Rechengenauigkeit bei EXCEL auf 16 Stellen begrenzt ist, was zu deutlich erkennbaren Fehlern führt.
(1)
Die Trendlinie von EXCEL ist da besser, allerdings weiß ich nicht, wie ich die einblendbaren Koeffizienten aus dem Textfeld extrahieren kann. Kann mir da jemand helfen? Bitte!!!!!
oder (2)
Weiß jemand, wie man das Ausgleichpolynom mit EXCEL genauer berechnen kann, ohne zusätzliche (kommerzielle) dll's zu benutzen?
Danke schon 'mal im Voraus.
Gruß Sven

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Ausgleichspolynom
05.06.2006 08:45:18
Erich
Hallo Sven,
zu Frage (1): Da gibts ein Beispiel für lineare Trendlinien in
https://www.herber.de/forum/archiv/592to596/t592984.htm
Wegen Frage (2) lasse ich offen.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Ausgleichspolynom
05.06.2006 09:45:56
Cardexperte
Hallo,
schau dir mal die Funktion Steigung an (vorher aber addin Statistik laden)
Gruss WS
AW: Ausgleichspolynom
05.06.2006 11:07:49
Sven
Noch 'mal Danke für die Hilfe.
Unten findet ihr meine Lösung. Vielleicht kann diese ja von irgendwem nocheimal gebraucht werden.
Gruß Sven
Sub Ausgleichspolynom() Dim TempCache, Residue(6) Cells(1, 1).Select Fenster = ActiveWorkbook.Name BlattName = ActiveSheet.Name Bereich = Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Address ' --------------- Diagramm + Trendlinie erzeugen! Charts.Add With ActiveChart .ChartType = xlXYScatter .SetSourceData Source:=Sheets(BlattName).Range(Bereich), PlotBy:=xlColumns .SeriesCollection(1).Name = "=""Schneidkante""" .Location Where:=xlLocationAsObject, Name:=BlattName End With With ActiveChart .Axes(xlCategory).HasMajorGridlines = True .Axes(xlValue).HasMajorGridlines = True .HasLegend = False With .SeriesCollection(1) .Trendlines.Add(Type:=xlPolynomial, Order:=6, Forward:=0, Backward:=0, _ DisplayEquation:=True, DisplayRSquared:=False).Select With .Trendlines(1) .Border.ColorIndex = 3 .DataLabel.NumberFormat = "0.000000000000" Koeffizienten = .DataLabel.Text End With End With .ChartArea.Select End With ActiveWindow.Visible = False Selection.Delete ' --------------- Koeffizienten auslesen + rausschreiben! If IsEmpty(TempCache) <> True Then Erase TempCache TempCache = Split(Koeffizienten, "x") For Nr = 0 To 6 TempCache(Nr) = Right(TempCache(Nr), Len(TempCache(Nr)) - 1) If InStr(TempCache(Nr), "=") <> 0 Then TempCache(Nr) = Replace(TempCache(Nr), "=", " ") Residue(6 - Nr) = CDbl(TempCache(Nr)) Next Nr Cells(1, 4) = "Polynom" For Nr = 0 To 6 Cells(2 + Nr, 3) = "A" & Format(Nr, "0") Cells(2 + Nr, 4) = Residue(Nr) Next Nr End Sub
Anzeige
AW: Ausgleichspolynom
05.06.2006 11:07:59
Sven
Noch 'mal Danke für die Hilfe.
Unten findet ihr meine Lösung. Vielleicht kann diese ja von irgendwem nocheimal gebraucht werden.
Gruß Sven
Sub Ausgleichspolynom() Dim TempCache, Residue(6) Cells(1, 1).Select Fenster = ActiveWorkbook.Name BlattName = ActiveSheet.Name Bereich = Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Address ' --------------- Diagramm + Trendlinie erzeugen! Charts.Add With ActiveChart .ChartType = xlXYScatter .SetSourceData Source:=Sheets(BlattName).Range(Bereich), PlotBy:=xlColumns .SeriesCollection(1).Name = "=""Schneidkante""" .Location Where:=xlLocationAsObject, Name:=BlattName End With With ActiveChart .Axes(xlCategory).HasMajorGridlines = True .Axes(xlValue).HasMajorGridlines = True .HasLegend = False With .SeriesCollection(1) .Trendlines.Add(Type:=xlPolynomial, Order:=6, Forward:=0, Backward:=0, _ DisplayEquation:=True, DisplayRSquared:=False).Select With .Trendlines(1) .Border.ColorIndex = 3 .DataLabel.NumberFormat = "0.000000000000" Koeffizienten = .DataLabel.Text End With End With .ChartArea.Select End With ActiveWindow.Visible = False Selection.Delete ' --------------- Koeffizienten auslesen + rausschreiben! If IsEmpty(TempCache) <> True Then Erase TempCache TempCache = Split(Koeffizienten, "x") For Nr = 0 To 6 TempCache(Nr) = Right(TempCache(Nr), Len(TempCache(Nr)) - 1) If InStr(TempCache(Nr), "=") <> 0 Then TempCache(Nr) = Replace(TempCache(Nr), "=", " ") Residue(6 - Nr) = CDbl(TempCache(Nr)) Next Nr Cells(1, 4) = "Polynom" For Nr = 0 To 6 Cells(2 + Nr, 3) = "A" & Format(Nr, "0") Cells(2 + Nr, 4) = Residue(Nr) Next Nr End Sub
Anzeige
AW: Ausgleichspolynom
05.06.2006 11:08:21
Sven
Noch 'mal Danke für die Hilfe.
Unten findet ihr meine Lösung. Vielleicht kann diese ja von irgendwem nocheimal gebraucht werden.
Gruß Sven

Sub Ausgleichspolynom()
Dim TempCache, Residue(6)
Cells(1, 1).Select
Fenster = ActiveWorkbook.Name
BlattName = ActiveSheet.Name
Bereich = Range(Range("A1:B1"), Range("A1:B1").End(xlDown)).Address
' --------------- Diagramm + Trendlinie erzeugen!
Charts.Add
With ActiveChart
.ChartType = xlXYScatter
.SetSourceData Source:=Sheets(BlattName).Range(Bereich), PlotBy:=xlColumns
.SeriesCollection(1).Name = "=""Schneidkante"""
.Location Where:=xlLocationAsObject, Name:=BlattName
End With
With ActiveChart
.Axes(xlCategory).HasMajorGridlines = True
.Axes(xlValue).HasMajorGridlines = True
.HasLegend = False
With .SeriesCollection(1)
.Trendlines.Add(Type:=xlPolynomial, Order:=6, Forward:=0, Backward:=0, _
DisplayEquation:=True, DisplayRSquared:=False).Select
With .Trendlines(1)
.Border.ColorIndex = 3
.DataLabel.NumberFormat = "0.000000000000"
Koeffizienten = .DataLabel.Text
End With
End With
.ChartArea.Select
End With
ActiveWindow.Visible = False
Selection.Delete
' --------------- Koeffizienten auslesen + rausschreiben!
If IsEmpty(TempCache) <> True Then Erase TempCache
TempCache = Split(Koeffizienten, "x")
For Nr = 0 To 6
TempCache(Nr) = Right(TempCache(Nr), Len(TempCache(Nr)) - 1)
If InStr(TempCache(Nr), "=") <> 0 Then TempCache(Nr) = Replace(TempCache(Nr), "=", " ")
Residue(6 - Nr) = CDbl(TempCache(Nr))
Next Nr
Cells(1, 4) = "Polynom"
For Nr = 0 To 6
Cells(2 + Nr, 3) = "A" & Format(Nr, "0")
Cells(2 + Nr, 4) = Residue(Nr)
Next Nr
End Sub

Anzeige
AW: Ausgleichspolynom
05.06.2006 12:30:40
Erich
Hallo Sven,
noch ein Tipp zur Zerlegung der Trendfunktion:
Deine Routine funzt nur, wenn alle Potenzen vorkommen.
(In der Praxis dürfte das wohl auch meist der Fall sein.)
Deshalb hatte ich die Indizes aus den Potenzen ermittelt.
Hier nochmal die beiden Funktionen: 
Sub tst_Koeff()
Dim arrE, strTrend As String
strTrend = Cells(5, 1)
arrE = Koeff2(strTrend)
Cells(6, 2) = "Koeff2"
For ii = 0 To 6
Cells(ii + 7, 1) = ii
Cells(ii + 7, 2) = arrE(ii)
Next ii
Cells(6, 3) = "Koeff3"
arrE = Koeff3(strTrend, 6)
For ii = 0 To 6
Cells(ii + 7, 3) = arrE(ii)
Next ii
End Sub
Function Koeff2(Koeffizienten As String)
Dim Nr As Byte, Residue() As Double
ReDim Residue(6)
TempCache = Split(Koeffizienten, "x")
For Nr = 0 To UBound(TempCache) ' 6, wenn alle 7 Potenzen Koeff. haben
TempCache(Nr) = Right(TempCache(Nr), Len(TempCache(Nr)) - 1)
If InStr(TempCache(Nr), "=") <> 0 Then TempCache(Nr) = Replace(TempCache(Nr), "=", " ")
Residue(6 - Nr) = CDbl(TempCache(Nr))
Next Nr
Koeff2 = Residue
End Function
Function Koeff3(strT As String, Grad As Byte)
Dim strZ As String, arrA, arrB() As Double
ReDim arrB(Grad)
strZ = Replace(Replace(strT, "+ ", "+"), "- ", "-")
If Left(strZ, 1) = "y" Then strZ = Trim(Right(strZ, Len(strZ) - 1))
If Left(strZ, 1) = "=" Then strZ = Trim(Right(strZ, Len(strZ) - 1))
arrA = Split(strZ, " ")
For ii = 0 To UBound(arrA)
Select Case InStr(arrA(ii), "x")
Case 0:              arrB(0) = arrA(ii)
Case Len(arrA(ii)):  arrB(1) = Left(arrA(ii), Len(arrA(ii)) - 1)
Case Else:           arrB(Right(arrA(ii), 1)) = Left(arrA(ii), Len(arrA(ii)) - 2)
End Select
Next ii
Koeff3 = arrB
End Function
und die Ergebnisse (bei fehlenden x4-Glied in der Fkt):
Tabelle1
  
 ABCD
5y = -6,6x6 + 0,5x5 + 33,3x3 - 2x2 + 444,4x - 9,9
6 Koeff2Koeff3 
700-9,9 
81-9,9444,4 
92444,4-2 
103-233,3 
11433,30 
1250,50,5 
136-6,6-6,6 
 
 Diagramm - Grafik - Excel Tabellen einfach im Web darstellen    Excel Jeanie HTML  3.0    Download  

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

                    


                    


    
Anzeige

    

        
                    
            
                
    



            


    
    


                    
                                
            

    
    

        

            
            

                                    

                                                    
                            AW: Ausgleichspolynom
                                            

                    

                                                    05.06.2006 16:36:19
                                            

                                

                                            Sven
                                    

            

        

        

                            
Hallo Erich,

absolut richtige Anregung. Danke für den Hinweis. Allerdings liefert EXCEL Algorithmus-bedingt immer alle Koeffizienten (wenn's sein muss: 1E-17 ö.ä.). Falls sich dies ändert, weiß ich jetzt wie's geht. Danke. Gruß aus Kassel.

                    


            


    
    


                    
                                
            

    
    

        

            
            

                                    

                                                    
                            AW: Ausgleichspolynom
                                            

                    

                                                    05.06.2006 10:48:06
                                            

                                

                                            Erich
                                    

            

        

        

                            
Hallo Sven,

nochmal zu Frage (1) - wenn es um das Ermitteln der Koeffizienten aus der Funktion geht, dann z. B. so:

Sub tst_Koeff()
Dim arrB, strTrend As String
strTrend = "y = -1,9014x6 + 45,196x5 - 422,87x4 + 1972,9x3 - 4777,7x2 + 5595,4x - 2378"
arrB = Koeff(strTrend, 6)
For ii = 0 To 6
ActiveSheet.Cells(ii + 6, 2) = arrB(ii)
Next ii
End Sub
Function Koeff(strT As String, Grad As Byte)
Dim strZ As String, arrA, arrB() As Double
ReDim arrB(Grad)
strZ = Replace(Replace(strT, "+ ", "+"), "- ", "-")
If Left(strZ, 1) = "y" Then strZ = Trim(Right(strZ, Len(strZ) - 1))
If Left(strZ, 1) = "=" Then strZ = Trim(Right(strZ, Len(strZ) - 1))
arrA = Split(strZ, " ")
For ii = 0 To UBound(arrA)
Select Case InStr(arrA(ii), "x")
Case 0
If arrA(ii) = "+" Or arrA(ii) = "-" Then
vz = arrA(ii)
Else
arrB(0) = vz & arrA(ii)
End If
Case Len(arrA(ii)):  arrB(1) = Left(arrA(ii), Len(arrA(ii)) - 1)
Case Else:           arrB(Right(arrA(ii), 1)) = vz & Left(arrA(ii), Len(arrA(ii)) - 2)
End Select
Next ii
Koeff = arrB
End Function

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

                    


                    


    
Anzeige

    

        
                    
            
                
    



            


    
    


                    
                                
            

    
    

        

            
            

                                    

                                                    
                            AW: Ausgleichspolynom
                                            

                    

                                                    05.06.2006 10:55:10
                                            

                                

                                            Erich
                                    

            

        

        

                            
Hallo Sven,

sorry, da war noch Müll in der Function, also noch mal:


Function Koeff(strT As String, Grad As Byte)
Dim strZ As String, arrA, arrB() As Double
ReDim arrB(Grad)
strZ = Replace(Replace(strT, "+ ", "+"), "- ", "-")
If Left(strZ, 1) = "y" Then strZ = Trim(Right(strZ, Len(strZ) - 1))
If Left(strZ, 1) = "=" Then strZ = Trim(Right(strZ, Len(strZ) - 1))
arrA = Split(strZ, " ")
For ii = 0 To UBound(arrA)
Select Case InStr(arrA(ii), "x")
Case 0:              arrB(0) = arrA(ii)
Case Len(arrA(ii)):  arrB(1) = Left(arrA(ii), Len(arrA(ii)) - 1)
Case Else:           arrB(Right(arrA(ii), 1)) = Left(arrA(ii), Len(arrA(ii)) - 2)
End Select
Next ii
Koeff = arrB
End Function

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

                    


                    


    
Anzeige

    

        
                    
            
                
    



            


    
    


            
    
    
    
    
    
            


    

        
        Links zu Excel-Dialogen
    

    

        

                            
                
                    
                    Label
                
                    

    




    
    
    
    
            


    

        
        Beliebteste Forumthreads (12 Monate)
    

    
    

 

    
    
    


    
Anzeige

    

        
                    
                
    




    
    

    

        

            

                
                    Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
                
            

            

                

                
            

        

    




    
    

    
    
            
 

            
            

                
                
                                    

                        


    

        
        Beliebteste Forumthreads (12 Monate)
    

    
    

 

                    

                                


    
Anzeige

    

        
                    
            
                
    



                


    
Anzeige

    

        
                    
            
                
    



                


    
Anzeige