从xy图VBA删除空数据系列

Question

我有一个vba代码，该代码根据数据的总行数逐行添加一系列数据。根据一列数据中的最小值，创建两个图表。我在vba的技能非常基础。

当我运行代码时，将生成图形，但是第一个图形添加了许多空数据系列。我不确定为什么会这样，并想在生产后将其删除或首先停止添加它们。

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

任何帮助将不胜感激，

柔道

Answer 1

未经测试，但这应该更易于使用：

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