基于VBA的海图自动生成

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

我有一个向量

p（m）

，它从

1

到

n\u r

。该向量在从

1

到

Ntime

的for循环中以“时间步长”进行更新（

j

计数器变量，如下代码所示）。我希望在同一图表中为我的

j

每次增加创建新的序列，最好是“直线散点”图表

我的p（m）向量写入下图所示的单元格，为每个新的j向右侧写入一列

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

---

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

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

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

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

---

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

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

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

---

创建

图表

和

系列集合

的相关代码在哪里？图表是不使用宏创建的。我对VBA编程相当陌生，所以不确定SeriesCollection是什么。很抱歉我想将新系列添加到的图表位于一个名为PRT的单独表格中。可以添加现有图表的屏幕截图，以及您想从中获取数据以添加更多的

系列

（不确切地说，您的

P（m）在哪里）

vector？已添加屏幕截图。谢谢。创建

图表和
系列集合的相关代码在哪里？
SeriesCollection
？该图表未使用宏创建。我对VBA编程非常陌生，因此不确定SeriesCollection是什么。抱歉，我要添加新系列的图表位于单独的表格中名为PrtMaybe添加现有图表的屏幕截图，以及您希望从何处获取数据以添加更多的
系列
（不确切地说，您的
P（m）
vector在哪里？已添加了屏幕截图。非常感谢感谢！这非常有帮助：）非常感谢！这非常有帮助：）
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

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