Удалить пустую серию данных из графика xy VBA - PullRequest
Новая
       4

Удалить пустую серию данных из графика xy VBA

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

У меня есть код VBA, который добавляет серии данных строка за строкой на основе общего количества строк данных. На основе минимального значения в одном столбце данных создаются две диаграммы. Мои навыки в vba очень просты c.

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

Sub Button6_Click()

Dim xrng As Range
Dim yrng As Range
Dim x2rng As Range
Dim y2rng As Range
Dim i As Integer
Dim Rng As Range
Dim l As Integer
Dim k As Integer
Dim i2 As Integer
Dim c As Integer
Dim j As Integer

Worksheets("Template").Activate

Dim lv As String
    lv = Worksheets("Template").Range(Worksheets("Template").Range("B11"), Worksheets("Template").Range("B11").End(xlDown)).Find(WorksheetFunction.Small(Worksheets("Template").Range(Worksheets("Template").Range("B11"), Worksheets("Template").Range("B11").End(xlDown)), 1), , , 1).Address
    Range(lv).Select
l = ActiveCell.Row

k = Worksheets("Template").Range(Worksheets("Template").Range("B11"), Worksheets("Template").Range("B11").End(xlDown)).Rows.Count

c = l - 10

i = 1
i2 = 1
j = 1

Set xrng = Worksheets("Template").Range("C11:CP11")
Set yrng = Worksheets("Template").Range("C201:CP201")
Set x2rng = xrng.Offset(1, 0)
Set y2rng = yrng.Offset(1, 0)

Dim DownSweep As Chart
    Set DownSweep = Charts.Add

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

i = i + 1

ITERATE:

If i < c Then

DownSweep.SeriesCollection.NewSeries
DownSweep.SeriesCollection(i).XValues = x2rng
DownSweep.SeriesCollection(i).Values = y2rng
Set x2rng = x2rng.Offset(1, 0)
Set y2rng = y2rng.Offset(1, 0)
i = i + 1
GoTo ITERATE

Else

End If

If i < k Then

Dim UpSweep As Chart
    Set UpSweep = Charts.Add

With UpSweep
    UpSweep.ChartType = xlXYScatter
    UpSweep.SeriesCollection.NewSeries
    UpSweep.SeriesCollection(1).XValues = x2rng
    UpSweep.SeriesCollection(1).Values = y2rng
End With

End If

i = i + 1
i2 = i2 + 1

ITERATE2:

If i < k Then

UpSweep.SeriesCollection.NewSeries
UpSweep.SeriesCollection(i2).XValues = x2rng
UpSweep.SeriesCollection(i2).Values = y2rng
Set x2rng = x2rng.Offset(1, 0)
Set y2rng = y2rng.Offset(1, 0)
i = i + 1
i2 = i2 + 1
GoTo ITERATE2

Else

End If

End Sub

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

Дзюдо

1 Ответ

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

Не проверено, но с этим должно быть проще работать: 

Sub Button6_Click()

    Dim xrng As Range, yrng As Range
    Dim i As Long
    Dim rng As Range
    Dim l As Long
    Dim k As Long
    Dim i2 As Long
    Dim c As Long
    Dim j As Long
    Dim DownSweep As Chart, UpSweep As Chart, cht As Chart
    Dim ws As Worksheet, smallest

    Set ws = Worksheets("Template") '<< use variables for worksheets!

    Set rng = ws.Range(ws.Range("B11"), ws.Range("B11").End(xlDown))

    smallest = WorksheetFunction.Small(rng, 1)
    l = rng.Find(what:=smallest, LookIn:=xlValues, lookat:=xlWhole).Row
    k = rng.Rows.Count

    c = l - 10

    Set xrng = ws.Range("C11:CP11")
    Set yrng = ws.Range("C201:CP201")

    Set DownSweep = Charts.Add
    DownSweep.ChartType = xlXYScatter

    Set UpSweep = Charts.Add
    UpSweep.ChartType = xlXYScatter

    For i = 1 To k
        Set cht = IIf(i <= c, DownSweep, UpSweep) 'which chart to add to ?
        With cht.SeriesCollection.NewSeries()
            .XValues = xrng.Offset(i - 1, 0).Value
            .Values = yrng.Offset(i - 1, 0).Value
        End With
    Next i

End Sub

РЕДАКТИРОВАТЬ: Это, используя IIf()

Set cht = IIf(i <= c, DownSweep, UpSweep)

, равно 

If i <= c Then
    Set cht = DownSweep
Else
    Set cht = UpSweep
End If
...