Копирование трендового уравнения не работает должным образом

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