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

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

0 голосов
/ 27 мая 2018

Я бы хотел просмотреть четыре набора данных, расположенных в строках.Я хотел бы сделать диаграмму из каждого набора данных и применить линию тренда, позвольте 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

Ferenc

1 Ответ

0 голосов
/ 27 мая 2018

Была ли некоторая очистка кода, и это работает для меня: 

    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

Очевидно, вам нужно использовать объект диапазона при определении исходных данных, и вам нужно активировать диаграмму, прежде чем вы сможете получить уравнение изit.

Edit # 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
...