AW: Formel der Diagramm Trendline zum rechnen benutzen
22.08.2006 22:56:36
ingUR
Hallo, Herby,
danke für Deien Arbeitsmappe, die mir gezeigt hat, dass wohl Christian auch nur mit "Wasser kocht" ;) , denn das Hochzeichen ^ hat mich verwirrt, taucht es doch in dem Text und Caption von DateLabel der Trendlinie nicht auf, warum ich meinte dass da irgendwo noch eine geheime Quelle ist.
Nun habe ich Deine Ausarbeitung dazu benutst, um das Anlegen der Zellen mit den Konstanten zu ersparen und die Gleichung flexibel ohne Zellenformel zu lösen:
Sub Wendepunkt_Berechnen()
On Error GoTo Fehlerbehandlung
Sheets("diagramm1").Select
ActiveChart.SeriesCollection(1).Trendlines(1).Select
Worksheets("Tabelle1").Cells(1, 4) = ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text
'----------- Einschub 1 ----------------------------------------
Dim strGL As String, GL_Type As Integer, GL_Order As Integer
strGL = ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text
strGL = Replace(Replace(Mid(strGL, 5), ",", "."), " ", "")
GL_Type = ActiveChart.SeriesCollection(1).Trendlines(1).Type
GL_Order = ActiveChart.SeriesCollection(1).Trendlines(1).Order
Sheets("Tabelle1").Select
'----------- Einschub 2 ----------------------------------------
Call CalcGL(strGL, GL_Type, GL_Order)
'----------- Ende Einschub 2 -----------------------------------
Range("D1").Select
SendKeys "~"
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"x", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1))
Exit Sub
Fehlerbehandlung:
Resume Next
End Sub
'======================= Neue Unterprogramme ========================
' Auswahl nach Trendlinientyp
'--------------------------------------------------------------------
Sub CalcGL(strGL As String, GL_Type As Integer, GL_Order As Integer)
Select Case GL_Type
Case xlPolynomial: Call TL_Polynomial(strGL, GL_Order)
'Case xlExponential: ...
'Case xl
Case Else: Exit Sub
End Select
End Sub
'----------------- Trendlinienformel (maximaler Grag = 6 ------------
Sub TL_Polynomial(strGL As String, GL_Order As Integer)
Dim p As Integer, a(6) As Double, v As Double
Dim r As Long, i As Integer
i = GL_Order
'***** Emittlung der Koeffizenten a(i) für i=0 bis GL_Order
While Len(strGL) > 0
p = InStr(strGL, "x" & i)
If p > 0 Then
a(i) = Val(strGL)
strGL = Mid(strGL, p + 2)
i = i - 1
Else
p = InStr(strGL, "x")
If p > 0 Then
a(1) = Val(strGL)
strGL = Mid(strGL, p + 1)
End If
a(0) = Val(strGL)
strGL = ""
End If
Wend
'**** Auswertung der Gleichung für x := Range("A2:A22")
For r = 2 To 22
v = a(0)
For i = 1 To GL_Order
v = v + a(i) * Cells(r, 1) ^ i
Next i
Cells(r, 3) = v
Next r
End Sub
'----------------------------------------------------------------
Gruß,
Uwe