excel - 如何在 VBA 中使用循环创建无限数量的图表

Question

我在电子表格中有无限年数的数据。我拥有的数据按照 imgur 屏幕截图中的方式排列。目前，我有 3 年的数据（2016-2018 年），但我希望我的代码能够无限期地工作，因为我会将它用于具有任意年数数据的数据集。我想每年将这些数据制作成三张图表：平均疾病风险####、平均疾病成本####、平均生物识别数据####。我希望这些图表显示在同一个电子表格上，因为数据排成三列并以年递增。

https://imgur.com/a/pO2ux7j

下面的代码仅用于平均疾病风险 #### 图表。

Sub ChartMake()

Dim ChartCount As Integer
ChartCount = ActiveSheet.ChartObjects.Count

If ChartCount > 0 Then
ActiveSheet.ChartObjects.Delete
End If

Dim NLoops As Integer, LoopNumber As Integer

NLoops = Worksheets("Data Input").Range("Q2").Value - 1

LoopNumber = 1

Dim cht As ChartObject, rngChart As Range, destinationSheet As String, Results As Worksheet, StartRow As Integer, EndRow As Integer, StartChart As Integer, EndChart As Integer

Set Results = Worksheets("Results")

destinationSheet = ActiveSheet.Name

Do While NLoops >= 0

StartRow = NLoops * 27
EndRow = NLoops * 27 + 5
StartChart = NLoops * 9 + 9
EndChart = NLoops * 9 + 17

Set co = Sheets("Results").ChartObjects.Add(6, StartChart, 5, 8)
ActiveSheet.ChartObjects(1).Activate
ActiveChart.SetSourceData Source:=Results.Range(Results.Cells(StartRow, "A"), Results.Cells(EndRow, "B"))
ActiveChart.ChartType = xlColumnClustered
ActiveChart.ChartTitle.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(72, 72, 72)
ActiveChart.Axes(xlCategory).TickLabels.Font.Color = RGB(72, 72, 72)
ActiveChart.Axes(xlValue).TickLabels.Font.Color = RGB(72, 72, 72)
ActiveChart.SeriesCollection(LoopNumber).Points(1).Interior.Color = RGB(59, 110, 172)
ActiveChart.SeriesCollection(LoopNumber).Points(2).Interior.Color = RGB(59, 110, 172)
ActiveChart.SeriesCollection(LoopNumber).Points(3).Interior.Color = RGB(59, 110, 172)
ActiveChart.SeriesCollection(LoopNumber).Points(4).Interior.Color = RGB(59, 110, 172)
ActiveChart.SeriesCollection(LoopNumber).Format.Shadow.Visible = msoTrue
Set cht = ActiveChart.Parent
With cht
.Left = Results.Cells(StartChart, "F").Left
.Top = Results.Cells(StartChart, "F").Top
.Height = Results.Range(Results.Cells(StartChart, "F"), Cells(EndChart, "J")).Height
.Width = Results.Range(Results.Cells(StartChart, "F"), Cells(EndChart, "J")).Width
End With
ActiveChart.Legend.Select
Selection.Delete

NLoops = NLoops - 1

LoopNumber = LoopNumber + 1

Loop

End Sub

当代码循环时，它会将源数据重新分配到下一个循环的年份，并移动到下一年的位置（2018 年的图表实际上变成了 2017 年的图表）。我认为这与我如何制作图表或图表对象或使用 ActiveChart 有关。

我怎样才能每次都制作一个新图表？我不知道如何无限期地为每个循环制作一个新的图表对象。

标签： excelvbaloopscharts