自动图表生成VBA

Question

我想在我创建的图表中自动生成新系列。

我有一个从1到n_r的向量P(m)。这个向量在从1到Ntime的for循环中的“时间步长”中更新(j计数器变量，如下面的代码所示)我希望每次j增加时，在同一图表中创建新的系列，最好是“直线散点”图表。

for j = 1 to Ntime    
    for m = 1 to n_r
        'calculating the vector P(m)    
    next m

    'code below writes vector P(m) to new columns for every new time step
    'stating in column D    
    For m = 1 To n_r
        Cells(2 + m, 3 + j) = P(m)
    Next m
Next j

我的P(m)向量写入下图所示的单元格，每个新的j向右写入一列

​

我想添加更多序列的图表如下所示：

非常感谢在这件事上的任何帮助。

Answer 1

几天前，我也遇到了同样的问题。我使用了下面的代码。

这不是对你问题的直接回答，但你可以把它作为一个起点。

我的代码创建了四个散点图(InsertOptionChart被调用了四次)，对于每个散点图，它逐个添加数据系列并设置它们的格式(标记、线条等)。

Option Explicit

Public Sub InsertOptionChartWrapper()
    Dim ewsOption As Worksheet: Set ewsOption = ThisWorkbook.Worksheets("Option")
    Dim r As Long: For r = 0 To 3
        InsertOptionChart _
            ewsOption.Range("B30:S65").Offset(37 * r, 0), _
            ewsOption.Range("BD179:CC179").Offset(25 * r, 0), _
            ewsOption.Range("BD180:CC180").Offset(25 * r, 0), _
            ewsOption.Range("B182:B202").Offset(25 * r, 0), _
            ewsOption.Range("BD182:CC202").Offset(25 * r, 0)
    Next r
End Sub

Public Sub InsertOptionChart(rngPlace As Range, rngParty As Range, rngOptionName As Range, rngRisk As Range, rngEv As Range)
    Dim chtTarget As Chart: Set chtTarget = rngParty.Worksheet.ChartObjects.Add(rngPlace.Left, rngPlace.Top, rngPlace.Width, rngPlace.Height).Chart
    chtTarget.ChartType = xlXYScatterSmooth

    Dim c As Long: For c = 1 To rngParty.Columns.Count
        Dim serActual As Series: Set serActual = chtTarget.SeriesCollection.NewSeries()
        serActual.XValues = rngRisk
        serActual.Values = rngEv.Columns(c)
        serActual.Name = rngParty.Cells(1, c) & " " & rngOptionName.Cells(1, c)

        serActual.Format.Line.Visible = msoFalse
        serActual.Format.Line.Visible = msoTrue
        serActual.Format.Line.Weight = 1

        serActual.MarkerSize = 5
        If rngParty.Cells(1, c).Value = "MT" Then
            serActual.MarkerStyle = xlMarkerStyleCircle
        Else
            serActual.MarkerStyle = xlMarkerStylePlus
        End If

        Select Case Left(rngOptionName.Cells(1, c).Value, 1)
        Case "S" ' Spot
            serActual.MarkerForegroundColor = RGB(0, 0, 0)
        Case "A"
            serActual.MarkerForegroundColor = RGB(237, 169, 90)
        Case "B"
            serActual.MarkerForegroundColor = RGB(159, 76, 151)
        Case "C"
            serActual.MarkerForegroundColor = RGB(100, 185, 228)
        Case "D"
            serActual.MarkerForegroundColor = RGB(64, 143, 154)
        Case "N" ' None
            serActual.MarkerForegroundColor = RGB(226, 0, 116)
        End Select

        Select Case Right(rngOptionName.Cells(1, c).Value, 4)
        Case "2019"
            serActual.Format.Line.DashStyle = msoLineSolid
        Case "2020"
            serActual.Format.Line.DashStyle = msoLineLongDash
        Case "2021"
            serActual.Format.Line.DashStyle = msoLineDash
        Case "2022"
            serActual.Format.Line.DashStyle = msoLineSquareDot
        Case Else
            serActual.Format.Line.DashStyle = msoLineSolid
        End Select

        serActual.MarkerBackgroundColorIndex = 2
        serActual.Format.Line.ForeColor.RGB = serActual.MarkerForegroundColor
    Next c

    chtTarget.Axes(xlValue).MajorGridlines.Delete
    chtTarget.Axes(xlValue).TickLabelPosition = xlLow
    chtTarget.Axes(xlCategory).MajorGridlines.Delete
    chtTarget.Axes(xlCategory).TickLabelPosition = xlLow

    chtTarget.Legend.Font.Size = 8
    chtTarget.Legend.Top = 0
    chtTarget.Legend.Height = chtTarget.Parent.Height
End Sub