复制趋势线方程无法正常工作

Question

我想遍历按行排列的四组数据。我想从每个数据集制作图表并应用趋势线，让 excel 显示趋势线方程并复制趋势线方程的 "m" 部分 (y=mx+b)在行尾后的单元格中。我在处理第一个数据集的整个过程时记录了一个宏，并对其进行了一些修改以引入循环。我的问题是，尽管代码使用趋势线和方程式创建了四个图表，但它在所有四行之后复制了第一个图表的 "m" 值。我试图解决这个问题，但失败了。现在 - 以相同的形式，所以我猜这是原始问题 - 此代码在每个数据集之后打印从代码复制到 clipboarb 的任何内容的第一行，在所有四个数据集之后，以及复制的剩余部分它下面的部分（只有一次）。它可能看起来没有意义，所以最好按以下方式尝试此代码：用数字和运行填充范围 C3:K6 代码。之后，将代码复制到剪贴板并再次运行代码。所以，我的两个问题是：1. 如何让代码在它们之后复制每个数据集的 "m" 值，以及 2. 为什么它现在表现得如此疯狂？

Sub Lasttest()

Dim i As Integer

For i = 3 To 6
  Range("C" & i).Select
  ActiveCell.Range("A1:I1").Select
  ActiveSheet.Shapes.AddChart.Select
  ActiveChart.ChartType = xlXYScatter
  ActiveChart.SetSourceData Source:=ActiveCell.Range("Sheet1!A1:I1")
  ActiveChart.SeriesCollection(1).Select
  ActiveChart.SeriesCollection(1).Trendlines.Add
  ActiveChart.SeriesCollection(1).Trendlines(1).Select
  Selection.DisplayEquation = True
  ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
  ActiveCell.Offset(0, 10).Range("A1").Select
  ActiveSheet.Paste
Next

End Sub

费伦茨

Answer 1

做了一些代码清理，这对我有用：

    Sub InsertChartsAndPrintEquations()

    Dim i As Integer
    Dim rng As Range

    For i = 3 To 6
      Set rng = Range("C" & i & ":K" & i)

      ' insert chart
      ActiveSheet.Shapes.AddChart.Select
      With ActiveChart
        .ChartType = xlXYScatter
        .SetSourceData Source:=rng
        With .SeriesCollection(1)
            .Trendlines.Add
            .Trendlines(1).DisplayRSquared = False
            .Trendlines(1).DisplayEquation = True
        End With

        ' grab & insert equation
        With ActiveSheet.ChartObjects(i - 2)
            .Activate
            Range("M" & i) = .Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text
        End With
      End With
    Next

End Sub

显然，在定义源数据时必须使用范围对象，并且必须先激活图表才能从中获取方程式。

编辑#1

这段代码应该更健壮：

Sub InsertChartsAndPrintEquations2()

    Dim i As Integer
    Dim rng As Range
    Dim cht As ChartObject

    ' add charts
    For i = 3 To 10
      Set rng = Range("C" & i & ":K" & i)
      ActiveSheet.Shapes.AddChart.Select

      With ActiveChart
        .ChartType = xlXYScatter
        .SetSourceData Source:=rng
        With .SeriesCollection(1)
            .Trendlines.Add
            .Trendlines(1).DisplayRSquared = False
            .Trendlines(1).DisplayEquation = True
        End With
      End With
    Next

    ' grab & insert equations
    i = 3 ' set to same starting value as in the for next loop above
    For Each cht In ActiveSheet.ChartObjects
        cht.Activate
        Range("M" & i) = cht.Chart.SeriesCollection(1).Trendlines(1).DataLabel.Text
        i = i + 1
    Next cht

End Sub

复制趋势线方程无法正常工作

Copying trendine equation not working properly

excel

copy-paste

equation

trendline

vba