| |
▼yuji さん：
>ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text
>という方法では、読み取った近似曲線の数式の桁数が５桁となってしまうようです。
>（尚、グラフ上の数式表示はちゃんと10桁で表示されます）
なるほど、そのようですね。
> Selection.NumberFormatLocal = "0.0000000000_ "
書式を「指数表示」にしておけば桁落ちすることはないと思います。
以下は（むかし作ったものですが）対象トレンドラインをマウスで選択しておいて
実行すると、どこに計数を書き込むか聞いてきますので、
書き出し先セルを指定してください。
（近似式を得るというより、係数を得るほうがあとの補間計算に使いやすいと
思いましたので、計数だけを複数セルに分けて出力しています。）
Sub 選択TrendLineの係数を得る()
Dim Coef '係数を格納
Dim c As Range
'★グラフの系列を選択して実行すること
If TypeName(Selection) <> "Trendline" Then
MsgBox "近似曲線を選択して実行してください"
Exit Sub
End If
Coef = GetCoef(Selection)
On Error Resume Next
Set c = Application.InputBox("書き出し先先頭セルを指定してください", Type:=8)
On Error GoTo 0
If Not c Is Nothing Then
c.Resize(, UBound(Coef) + 1).Value = Coef '横方向に書き出すばあい
'c.Resize(UBound(Coef) + 1).Value = Application.Transpose(Coef)
Set c = Nothing
End If
End Sub
'--- TrendLineの各係数を返す
Private Function GetCoef(TL As Trendline) As Variant
Dim v, u
Dim j As Long, k As Long
Dim ss As String
Dim disp As Boolean
With TL
disp = .DisplayEquation
.DisplayEquation = True
.DataLabel.NumberFormatLocal = "0.0000000E+00"
ss = .DataLabel.Text
.DisplayEquation = disp
End With
j = InStr(ss, "R2")
If j Then ss = Left$(ss, j - 1)
j = InStr(ss, "=")
ss = Mid$(ss, j + 2)
ss = Replace(ss, "+ ", "+")
ss = Replace(ss, "- ", "-")
Debug.Print ss
Select Case TL.Type
Case xlLinear, xlPolynomial
v = Split(ss)
If TL.Type = xlLinear Then k = 1 Else k = TL.Order
ReDim u(k) As Double
For j = 0 To k
u(j) = Val(v(j))
Next
Case xlExponential
ReDim u(1) As Double
v = Split(ss, "e")
u(0) = Val(v(0))
u(1) = Val(v(1))
Case xlPower
ReDim u(1) As Double
v = Split(ss, "x")
u(0) = Val(v(0))
u(1) = Val(v(1))
Case Else
MsgBox "Can't get Coeff from Series because of " & TL.Type
GetCoef = False
Exit Function
End Select
GetCoef = u
End Function
|
|
kanabun
- 09/5/24(日) 21:32 -
