Добавление дополнительных серий в Scattergraph - PullRequest
Новая
       25

Добавление дополнительных серий в Scattergraph

0 голосов
/ 24 марта 2020

Я пытаюсь создать код, который добавляет серии в график рассеяния. Код выполняется, но добавлено около 100 дополнительных серий данных, которые не были указаны. Мои навыки VBA: Basi c. 

Dim DownSweep As Chart
Dim xrng As Range
Dim yrng As Range
Dim title As Range
Dim dsvt As Worksheet
Dim dst As Worksheet
Dim i As Integer

t = 1

CLEAN:
    If t < ActiveWorkbook.Charts.Count + 1 Then
    If ActiveWorkbook.Charts(t).Name = "DownSweep Graph" Then
    Application.DisplayAlerts = False
    ActiveWorkbook.Charts("DownSweep Graph").Delete
    Application.DisplayAlerts = True
    t = t + 1
    GoTo CLEAN
    End If
    End If

    Set dst = Worksheets("Template 2 - Down Sweep")
    Set dsvt = Worksheets("DownSweep ViscosityTemperature")

Set xrng = dsvt.Range(dsvt.Range("C2"), dsvt.Range("C2").End(xlDown))
Set yrng = dsvt.Range(dsvt.Range("F2"), dsvt.Range("F2").End(xlDown))
Set title = dsvt.Range("F1")

dsvt.Range("E1").Select

    Set DownSweep = Charts.Add
    DownSweep.Name = "DownSweep Graph"

    With DownSweep
            .ChartType = xlXYScatter
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = xrng
            .SeriesCollection(1).Values = yrng
            .SeriesCollection(1).Name = title
    End With

title = title.Offset(0, 1)

For i = 2 To 99
        With DownSweep.SeriesCollection.NewSeries()
            .XValues = xrng.Offset(0, i - 1).Value
            .Values = yrng.Value
            .Name = title
        End With
        title = title.Offset(0, i)
    Next i

End Sub

Как мне предотвратить это?

Буду признателен за любую помощь.

1 Ответ

0 голосов
/ 24 марта 2020

Это потому, что вы выбираете ячейку в исходных данных перед добавлением диаграммы. Поэтому он автоматически устанавливает эти данные в качестве источника и создает коллекцию серий.

Поэтому либо убедитесь, что активная ячейка не находится в исходных данных, либо используйте следующий код для удаления существующей коллекции серий до добавив свою новую коллекцию серии. 

With DownSweep
    Do While .SeriesCollection.Count > 0
        .SeriesCollection(1).Delete
    Loop
End With
...