Question

我想循环排列成行的四组数据。我想从每个数据集创建一个图表并应用趋势线，让excel显示趋势线的等式并复制＆＃34; m＆＃34;在行结束之后的单元格中趋势线（y = mx + b）的等式的一部分。我在使用第一个数据集执行整个过程时记录了一个宏，并对其进行了一些修改以引入循环。我的问题是，尽管代码使用趋势线和方程创建了四个图表，但它复制了＆＃34; m＆＃34;所有四行之后的第一个图表的值。我试图解决问题，但失败了。现在 - 以相同的形式，所以我猜这是oroginal问题 - 这个代码在每个数据集之后打印从代码复制到clipboarb的第一行以及所有四个数据集之后，以及复制的剩余部分它下面的部分（只有一次）。它似乎毫无意义，因此最好以下列方式尝试此代码：使用数字填充范围C3：K6并运行代码。之后，将代码复制到剪贴板并再次运行代码。所以，我的两个问题是：1。如何使代码复制＆＃34; m＆＃34;它们之后的每个数据集的值和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

Ferenc的

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

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

1 个答案: