自動チャート生成VBA

Question

私が作成したチャートで新しいシリーズの生成を自動化したいと思います。

私はベクトルP(m)を持っています。これは1からn_rになります。このベクトルは1からNtime（下のコードではjのカウンター変数）からなるforループの「タイムステップ」で更新されます。jが増えるたびに同じチャートの新しいシリーズを作成したい、できればa "直線で散らす"チャート。

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について、以下の図に示すセルへの書き込みを右に1つのコラムを執筆します次のようになります。 この問題のお手伝いをさせていただきます。

Answer 1

数日前、同じ問題が発生しました。私は以下のコードを使用しました。

これはあなたの質問に対する直接的な回答ではありませんが、出発点として使用できます。

私のコードは、4つの散布図を（InsertOptionChartを4回と呼ばれる）を作成し、各散布図のために、それは1対1によってdataseriesを追加し、そのフォーマット（マーカー、ライン、等）

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