[已解决]拟合曲线,如何引出其中的方程式和系数?

试验资料

各位大神帮忙看下:

Private Sub CommandButton1_Click()
    ActiveSheet.ChartObjects("图表 1").Activate
    ActiveChart.SeriesCollection(1).Trendlines(1).Select
    With Selection
        .Type = xlPolynomial
        .Order = [b38] + 2
        .Forward = 0.5
        .Backward = 0.5
        .InterceptIsAuto = True
        .DisplayEquation = True
        .DisplayRSquared = True
        .NameIsAuto = True
    End With
    Range("r33").Text = Sheet.ChartObjects("图表 1").Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text
    ActiveWindow.Visible = False
End Sub
这是我写的VBA,其中黄色的部分出错了,我想把图表中的公式引用到单元格r33,请大神帮帮忙,万分感谢!

最佳答案

月排行榜 / 总排行榜

爱疯

2016-2-5 09:11

Private Sub CommandButton1_Click()
    With ActiveSheet.ChartObjects("图表 1").Chart.SeriesCollection(1).Trendlines(1)
        .Type = xlPolynomial
        .Order = [b38] + 2
        .Forward = 0.5
        .Backward = 0.5
        .InterceptIsAuto = True
        .DisplayEquation = True
        .DisplayRSquared = True
        .NameIsAuto = True
        Range("r33") = .DataLabel.Text
    End With
'    ActiveWindow.Visible = False
End Sub



赋值时range对象不加text属性，就行了（不清楚为什么）

跳转到最佳答案楼层

爱疯

Private Sub CommandButton1_Click()
    With ActiveSheet.ChartObjects("图表 1").Chart.SeriesCollection(1).Trendlines(1)
        .Type = xlPolynomial
        .Order = [b38] + 2
        .Forward = 0.5
        .Backward = 0.5
        .InterceptIsAuto = True
        .DisplayEquation = True
        .DisplayRSquared = True
        .NameIsAuto = True
        Range("r33") = .DataLabel.Text
    End With
'    ActiveWindow.Visible = False
End Sub



赋值时range对象不加text属性，就行了（不清楚为什么）

lidayu

爱疯 发表于 2016-2-5 09:11
Private Sub CommandButton1_Click()
    With ActiveSheet.ChartObjects("图表 1").Chart.SeriesCollecti ...

请老师赐教，例如录入窗体TextBox22对应“资料库表”A列为（姓名），TextBox23：TextBox25对应B:D列为（项目1、项目2、项目3），三个条件只要满足其中的一个就结束过程。
例如：窗体TextBox22（姓名）=张三，TextBox23、TextBox24=“”、TextBox25=百姓超市，“资料库表”A3=张三，B3=百姓超市、C3=华隆超市、D3=苏果超市，满足1个或2个及3个条件都结束过程.
下面是3个条件都满足才结束过程，请老师修改谢谢！

1. <div>Private Sub CommandButton1_Click()
   
2.     Dim a As Integer
   
3.     Dim i As Long
   
4.     Dim myControl As Control
   
5.      Set d = CreateObject("Scripting.Dictionary")
   
6. '       ARR = Sheets("资料库").Range("a3:d" & Sheets("资料库").[d999].End(3).Row)
   
7.        Myr = Sheet6.[a65536].End(xlUp).Row
   
8.         ARR = Sheet6.Range("a3:d" & Myr)
   
9.          For i = 1 To UBound(ARR)
   
10.       d(ARR(i, 1) & ARR(i, 2) & ARR(i, 3) & ARR(i, 4)) = i
    
11.     Next
    
12.      If d.exists(TextBox22.Value & TextBox23.Value & TextBox24.Value & TextBox25.Value) Then
    
13.             CreateObject("WScript.Shell").Popup "该客户已存在!", 1, "提示"
    
14.         Unload Me
    
15.       Exit Sub
    
16.     End If
    
17.   a = Sheet6.[a65536].End(xlUp).Row
    
18.     With Sheet6.Range("A" & a + 1)
    
19.         .Offset(0, 0).Value = TextBox22.Value
    
20.         .Offset(0, 1).Value = TextBox23.Value
    
21.         .Offset(0, 2).Value = TextBox24.Value
    
22.         .Offset(0, 3).Value = TextBox25.Value
    
23.         .Offset(0, 4).Value = TextBox26.Value
    
24.         .Offset(0, 5).Value = TextBox27.Value
    
25.         .Offset(0, 6).Value = TextBox28.Value
    
26.     End With
    
27. End Sub

复制代码

lidayu

爱疯 发表于 2016-2-5 09:11
Private Sub CommandButton1_Click()
    With ActiveSheet.ChartObjects("图表 1").Chart.SeriesCollecti ...

爱版您好，我会重复发贴是因为之前贵论坛有人做“开票”广告占满了几个页面，所以才会重复发贴，请您理解。

爱疯

lidayu 发表于 2016-2-11 21:31
爱版您好，我会重复发贴是因为之前贵论坛有人做“开票”广告占满了几个页面，所以才会重复发贴，请您理解 ...

在不影响你的求助前提下，删了重复的主体题帖，以免别人重复回复。

我现在没什么时间，只要你的问题说明清楚了，总会有人来帮忙看的。

lidayu

爱疯 发表于 2016-2-11 21:52
在不影响你的求助前提下，删了重复的主体题帖，以免别人重复回复。

我现在没什么时间，只要你的问题说 ...

爱版您好，感觉描述的很清楚，可几天时间没有老师愿意帮助，代码只需稍作修改应该就可以，我就是水平太低了研究了几天都没能成功。像我这问题对老师您来说绝对是很轻易的就完成了，要是可能请您看看。谢谢！