Excel VBA脚本dynamic添加系列到图表
我试图dynamic添加多个系列到折线图。 事前我不知道有多less系列，所以需要dynamic的。 我想到的但是不起作用的是：
工作表ActiveSheet（或Sheets（“Data”））从C14开始具有行，直到包含从E14：Eend到R14：Rend的XValues和Columns的Cend，其中“end”标记由列C确定的最后一行数据。存储在第9行。XValues对于所有系列都是一样的。
我的大问题是，我无法find一种方法来dynamic地将所有的数据列连同相应的名称一起添加到我的图表中。 我不是VBA的专家，所以请善待。 我已经阅读了各种资料，并尝试了很多脚本，似乎没有任何工作。 对象目录有点帮助，但是我的问题依然存在。
Sub MakeChart() Dim LastColumn As Long Dim LastRow As Long Dim i As Integer Dim u As Integer Dim NameRng As String Dim CountsRng As Range Dim xRng As Range LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column ColumnCount = LastColumn - 4 LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row ' Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow) Charts.Add With ActiveChart .ChartType = xlLineMarkers .HasTitle = True .ChartTitle.Text = "Test" End With For i = 1 To ColumnCount u = i + 4 NameRng = Sheets("Data").Range("R9:C" & u).Value Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3") Set CountsRng = Sheets("Data").Range("R14:C" & u, "R" & LastRow & ":C" & u) ' Debug.Print ("CountsRng: R14:C" & u & ", R" & LastRow & ":C" & u & " NameRng: " & NameRng & " xRng: R14:C3 , R" & LastRow & ":C3") ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(i).XValues = xRng ActiveChart.SeriesCollection(i).Values = CountsRng ActiveChart.SeriesCollection(i).Name = NameRng Next i End Sub 谢谢您的帮助。 我解决了这个问题。 看来我已经完全搞乱了单元格范围的表示法。 你不能使用
Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")
而不得不使用
Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))
此外，使用Charts.Add并没有什么帮助，因为Excel试图自动find所有系列的正确范围，并添加它们导致完全混乱的图表。 更好的方法是使用
Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)
因为这将创build一个完全空的图，你可以添加你自己的系列
这里是任何感兴趣的人的完整和工作的代码：
Sub MakeChart() Dim LastRow As Long Dim LastColumn As Long Dim ColumnCount As Long LastRow = ActiveSheet.Range("C" & ActiveSheet.Rows.Count).End(xlUp).Row LastColumn = ActiveSheet.Cells(8, Columns.Count).End(xlToLeft).Column ColumnCount = LastColumn - 4 Debug.Print ("Last Column: " & LastColumn & " Count: " & ColumnCount & " LastRow: " & LastRow) Dim wsChart As Worksheet Set wsChart = Sheets(1) wsChart.Activate Dim ChartObj As ChartObject Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500) ChartObj.chart.ChartType = xlLineMarkers Dim i As Integer Dim u As Integer Dim NameRng As String Dim xRng As Range Dim CountsRng As Range For i = 1 To ColumnCount u = i + 4 With Sheets("Data") NameRng = .Cells(9, u).Value Set CountsRng = .Range(.Cells(14, u), .Cells(LastRow, u)) Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3)) Debug.Print "--" & i & "--" & u & "--" Debug.Print "x Range: " & xRng.Address Debug.Print "Name Range: " & .Cells(9, u).Address Debug.Print "Value Range: " & CountsRng.Address End With 'Set ChartSeries = ChartObj.chart.SeriesCollection.NewSeries 'With ActiveChart.SeriesCollection.NewSeries With ChartObj.chart.SeriesCollection.NewSeries .XValues = xRng .Values = CountsRng .Name = NameRng End With 'Set xRng = Nothing 'Set CountsRng = Nothing 'NameRng = "" Next i 'ChartObj.Activate With ChartObj.chart .SetElement (msoElementLegendBottom) .Axes(xlValue).MajorUnit = 1 .Axes(xlValue).MinorUnit = 0.5 .Axes(xlValue).MinorTickMark = xlOutside '.Axes(xlCategory).TickLabels.NumberFormat = "#,##000" .Axes(xlCategory).TickLabels.NumberFormat = "#,##0" '.Location Where:=xlLocationAsObject, Name:="Plot" End With End Sub
示例代码
Sub InsertChart() Dim first As Long, last As Long first = 10 last = 20 Dim wsChart As Worksheet Set wsChart = Sheets(1) wsChart.Activate wsChart.Shapes.AddChart.Select Dim chart As chart Set chart = ActiveChart chart.ChartType = xlXYScatter ' adding series chart.SeriesCollection.NewSeries chart.SeriesCollection(1).Name = "series name" chart.SeriesCollection(1).XValues = "=" & ActiveSheet.Name & "!$A$" & first & ":$A$" & last chart.SeriesCollection(1).Values = "=" & ActiveSheet.Name & "!$B$" & first & ":$B$" & last End Sub
你可以遍历范围并继续添加更多的系列