Построение нескольких данных на одном графике

Question

В настоящее время мой код только отображает диаграмму для альтернативного столбца y «средних значений» в области от столбца A до E с такими же значениями x (представлены как рабочая неделя). Но теперь, если я хочу включить данные из другого региона, такие как весь альтернативный столбец y «идеальные средние значения», которые также имеют те же значения x, как показано на рисунке 1, на одну и ту же диаграмму, как мне включить эти данные для заговор в VBA?

рисунок 1

В настоящее время

Ожидаемый

токовый выход

Ожидаемый выход

текущий код

Sub plotgraphs()

Call meangraph

End Sub

Private Sub meangraph()
    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,yourOtherRange As Range, rngdb1 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 = Worksheets("meangraphs").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 = 20
                .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




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 first series
    With .SeriesCollection.NewSeries()
        .XValues = rngX.Value
        .Values = yourOtherRange.Value
    End With

    'second series
    With .SeriesCollection.NewSeries()
        .XValues = rngX.Value
        .Values = yourOtherRange.Offset(0, 6).Value
    End With
end with



    Loop


end sub

Answer 1

Попробуй это. Ваш график лучше подходит для линейного графика, чем для распределенного.

Sub plotgraphs()

Call meangraph

End Sub

Private Sub meangraph()
    Dim i As Long, c As Long
    Dim r As Integer, n As Integer
    Dim k As Integer
    Dim Shp As Shape
    Dim Cht As Chart, co As Shape
    Dim rngDB As Range, rngX As Range
    Dim rngY() As Range, rngY2() As Range
    Dim rng As Range
    Dim Srs As Series
    Dim Ws As Worksheet
    Dim rngShp As Range



    Set Ws = Sheets("Data")


    With Ws
        Set rngDB = .Range("A1", .Cells(1, Columns.Count).End(xlToLeft))
        Set rngX = .Range("a2", .Range("a" & Rows.Count).End(xlUp))
        r = rngX.Rows.Count
    End With
    For Each rng In rngDB
        If InStr(rng, "mean") Then
            If Len(rng) = 5 Then
                n = n + 1
                ReDim Preserve rngY(1 To n)
                Set rngY(n) = rng.Offset(1, 0).Resize(r)
            Else
                c = c + 1
                ReDim Preserve rngY2(1 To c)
                Set rngY2(c) = rng.Offset(1, 0).Resize(r)
            End If
        End If
    Next rng
    k = 2
    For i = 1 To n '<~~~ Loop
         Set rngShp = Ws.Range("b" & k).Resize(10, 20)
         k = k + 11
         Set co = Worksheets("meangraphs").Shapes.AddChart
         Set Cht = co.Chart
         With co
            .Top = rngShp.Top
            .Left = rngShp.Left
            .Width = rngShp.Width
            .Height = rngShp.Height
        End With
         With Cht
             '.ChartType = xlXYScatter
             .ChartType = xlLineMarkers
             '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
             'For i = 1 To n '<~~~ Loop
                 Set Srs = .SeriesCollection.NewSeries
                 With Srs
                     .XValues = rngX
                     .Values = rngY(i)
                     .Format.Line.Visible = msoFalse
                     .MarkerStyle = xlMarkerStyleCircle
                     .MarkerSize = 5
                 End With
                 Set Srs = .SeriesCollection.NewSeries
                 With Srs
                     .XValues = rngX
                     .Values = rngY2(i)
                     .Format.Line.Visible = msoFalse
                     .MarkerStyle = xlMarkerStyleCircle
                     .MarkerSize = 5
                 End With

             'Next i
             'formatting...
             With Cht.Axes(xlValue)
                 .MinimumScale = 5
                 .MaximumScale = 20
                 .TickLabels.NumberFormat = "0.00E+00"
             End With
             Cht.Axes(xlCategory, xlPrimary).HasTitle = True
             Cht.Axes(xlValue, xlPrimary).HasTitle = True

         End With
    Next i
End Sub

Answer 2

    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 first series
        With .SeriesCollection.NewSeries()
            .XValues = rngX.Value
            .Values = rngY.Value
        End With

        'second series
        With .SeriesCollection.NewSeries()
            .XValues = rngX.Value
            .Values = rngY.Offset(0, 7).Value
        End With