Страницы: 1
RSS
Необходимо автоматически создавать точечную диаграмму по данным таблицы по отдельным рядам, Необходимо автоматически создавать точечную диаграмму по данным таблицы по отдельным рядам
 
У меня есть таблица на листе 1, из нее я строю точечную диаграмму в которой по оси X у меня значение Tmax (столбец L), а по Y значение HI (столбец N). При автоматическом выборе диапазона данных происходит шизофрения с рядами. В идеале он должен выбирать каждый ряд как отдельную строку со своим именем, иксом и игреком. Но скидывает все в кучу. Я руками сделал часть на листе 1, но автоматически у меня не получалось так делать(. Конечно, для 29 строчек я и руками могу внести все данные, эти данные могут изменяться и добавляться новые строчки. Поэтому прошу помощи и совета как сделать так чтобы автоматически раскидывало данные для точечной диаграммы как у меня в примере на листе 1? В файле так же есть лист 2 где отобраны именно те столбцы для экспериментов (неудачных). Для чего мне нужно все это дело как отдельные ряды? - Что бы точки были разных цветов и показывали свой номер.
 
Код
Sub AddPoints()
    If TypeName(Selection) <> "Range" Then
        MsgBox "Выберите диапазон.", vbInformation
        Exit Sub
    End If

    Dim ch As Chart
    Set ch = ActiveSheet.ChartObjects(1).Chart
    
    Dim cl As Range
    For Each cl In Intersect(Selection.EntireRow, ActiveSheet.UsedRange, Columns(1)).Cells
        If cl.Value <> "" Then
            ch.SeriesCollection.NewSeries
            With ch.FullSeriesCollection(ch.SeriesCollection.Count)
                .Name = "='" & ActiveSheet.Name & "'!$A$" & cl.Row
                .XValues = "='" & ActiveSheet.Name & "'!$L$" & cl.Row
                .Values = "='" & ActiveSheet.Name & "'!$N$" & cl.Row
                .ApplyDataLabels
                .HasLeaderLines = False
                With .DataLabels
                    .ShowValue = False
                    .ShowSeriesName = True
                    .Position = xlLabelPositionAbove
                End With
            End With
        End If
    Next
End Sub
Выделите диапазон.
 
Большое спасибо, помогло!
Страницы: 1
Наверх