在同一张图表上绘制多个数据

Question

目前，我的代码仅绘制从 A 列到 E 具有相同 x 值（表示为工作周）的区域中 y "mean values" 的交替列的图表。但是现在，如果我想将来自另一个区域的数据包括在同一图表中，例如 y "ideal mean values" 的整个交替列，它也具有与图 1 中突出显示的相同的 x 值，我如何也包括这些数据在 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

    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

Answer 2

试试这个。您的图表比分布式图表更适合线性图表。

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

在同一张图表上绘制多个数据

Plotting multiple data on the same chart

excel

vba

excel-charts