Как построить график, когда данные находятся в каждом альтернативном столбце в Excel VBA

Question

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

Отредактировано:

Значения X находятся в 1-м столбце, а значения y равны 2,4,6,8 et c ..

данные используются для построения графиков

Ожидаемый результат

Sub plotgraph()


 Dim i As Long, c As Long
    Dim shp As Shape
    Dim Cht As Chart
    Dim rngDB As Range, rngX As Range
    Dim Srs As Series
    Dim ws As Worksheet

     Set ws = Sheets("Data")

    Set rngDB = ws.UsedRange

    c = rngDB.Columns.Count
 Set shp = ws.Shapes.AddChart
Set Cht = shp.Chart

    With Cht
        For i = 1 To c Step 2 'For every alternate column so in step2
            With ws
                Set rngX = ws.Range(.Cells(2, i), .Cells(2, i).End(xlDown))

            End With

        Set Srs = .SeriesCollection.NewSeries
            With Srs
                .XValues = rngX
            End With
        Next i

     ws.Shapes.AddChart.Select
    Cht.ChartType = xlXYScatter
'    ActiveChart.SetSourceData Source:=Range("Data!$A:$A")
    Cht.Axes(xlValue).Select
    Cht.Axes(xlValue).MinimumScale = 6.45
    Cht.Axes(xlValue).MinimumScale = 5
    Cht.Axes(xlValue).MaximumScale = 6.8
    Cht.Axes(xlValue).MaximumScale = 9

         Cht.Axes(xlValue).TickLabels.NumberFormat = "0.00E+00"
        Cht.Axes(xlCategory, xlPrimary).HasTitle = True
        Cht.Axes(xlValue, xlPrimary).HasTitle = True
End With

End Sub

Выпуск

Answer 1

Примерно так:

Sub plotgraphs()


    Dim i As Long, c As Long
    Dim shp As Shape
    Dim Cht As Chart, co As Shape
    Dim rngDB As Range, rngX As Range, rngY As Range
    Dim Srs As Series
    Dim ws As Worksheet

    Set ws = Sheets("Data")

    Set rngDB = ws.Range("A1").CurrentRegion

    Set rngX = rngDB.Columns(1)
    Set rngY = rngDB.Columns(2)

    Do While Application.CountA(rngY) > 0

        Set co = ws.Shapes.AddChart
        Set Cht = co.Chart

        With Cht
            .ChartType = xlXYScatter
            'remove any data which might have been
            '  picked up when adding the chart
            Do While .SeriesCollection.Count > 0
                .SeriesCollection(1).Delete
            Loop
            'add the data
            With .SeriesCollection.NewSeries()
                .XValues = rngX.Value
                .Values = rngY.Value
            End With
            'formatting...
            With Cht.Axes(xlValue)
                .MinimumScale = 5
                .MaximumScale = 9
                .TickLabels.NumberFormat = "0.00E+00"
            End With
            Cht.Axes(xlCategory, xlPrimary).HasTitle = True
            Cht.Axes(xlValue, xlPrimary).HasTitle = True
        End With

        Set rngY = rngY.Offset(0, 2) 'next y values
    Loop

End Sub