自动图表生成VBA

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

我有一个从1n_r的vectorP(m) 。 这个向量在for循环中的“时间步骤”中进行更新,该循环从1Ntimej代码如下代码所示)我想在每次增加j时在同一个图表中创build新的系列,最好是“用直线分散”图表。

 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向右写入一列 在这里输入图像说明

下面显示了我想要添加更多系列的图表: 在这里输入图像说明 任何帮助在这个问题上,不胜感激

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

这不是你的问题的直接答案,但你可以用它作为一个起点。

我的代码创build了四个散点图(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