Vba 带空指针的图表循环

Vba chart loop with empty pointers

我需要每两列绘制一个图表,我有 30 列,所以我有 15 个图表我正在使用范围内的循环来做,但我在大多数图表中没有得到分数,只有三个他们我得到一个完整的图表,其他的是空的我不知道我做错了什么。 the image shows what I am getting

Sub loopChart(SheetName, ChartSheet, ChartTop)
' define variables
Dim myRange, newRange As Range
Dim c, r, l As Integer
Dim lRow As Long
Dim lColumn As Long

c = 1
r = 1
l = 0

' range of  each measure

lColumn = Sheets(SheetName).Cells(1, Columns.Count).End(xlToLeft).Column
lRow = Sheets(SheetName).Cells(Rows.Count, 1).End(xlUp).Row

'loop for each range of the data
While c < lColumn
'set data source for the next chart
    With Worksheets(SheetName)

        Set myRange = .Range(.Cells(1, c), .Cells(lRow, c + 1))


        For Each cell In myRange
            If cell.Value = "" Or cell.Offset(1, 0).Value = "" Then
                r = cell.Row
        Exit For
    End If
 Next

    Set newRange = .Range(.Cells(1, c), .Cells(r - 1, c + 1))

End With

'create chart
Sheets(ChartSheet).Select
    ActiveSheet.Shapes.AddChart.Select

    With ActiveChart

        '.Axes(xlValue)
        .ChartType = xlXYScatter 'xlLine
        .SetSourceData Source:=newRange, PlotBy:=xlColumns  'sets source data for graph including labels

        .SetElement (msoElementLegendRight)  'including legend
        .HasTitle = True
        'dimentions & location:

        .Parent.Top = ChartTop
        .Parent.Left = c * 200  'defines the coordinates for the left side of the chart
        .Parent.Height = 300
        .Parent.Width = 400
        .ChartTitle.Text = SheetName & " " & (c - l) ' name of the chart from the column of each range



    End With

c = c + 2
l = l + 1
Wend
End Sub
lColumn = Sheets(SheetName).Cells(1, Columns.Count).End(xlToLeft).Column
lRow = Sheets(SheetName).Cells(Rows.Count, 1).End(xlUp).Row
fBlank = lRow + 1

While c < lColumn
'set data source for the next chart
    With Worksheets(SheetName)

        Set myRange = .Range(.Cells(1, c), .Cells(fBlank, c + 1))

        For Each cell In myRange
         If cell.Value = cell.Offset(0, 1).Value Then
                r = cell.Row
        Exit For
    End If
 Next

    Set newRange = .Range(.Cells(1, c), .Cells(r - 1, c + 1))

End With