Excel VBA脚本,用于向图表动态添加系列
我正在尝试将多个系列动态添加到折线图中。我事先不知道有多少系列,所以它需要是动态的。我想到了但不起作用的是: 工作表ActiveSheet(或工作表(“数据”)包含从C14到Cend的行,其中包含从E14:Eend到R14:Rend的列,其中“end”标记由列C确定的最后一行数据。系列名称存储在第9行中。所有系列的X值都相同 我最大的问题是,我找不到一种方法来动态地将所有数据列作为序列添加到我的图表中,同时添加各自的名称。我不是VBA方面的专家,所以请善待我。我已经阅读了各种来源,并尝试了许多脚本,似乎没有一个工作。对象目录对我有点帮助,但我的问题仍然存在Excel VBA脚本,用于向图表动态添加系列,excel,vba,charts,dynamically-generated,Excel,Vba,Charts,Dynamically Generated,我正在尝试将多个系列动态添加到折线图中。我事先不知道有多少系列,所以它需要是动态的。我想到了但不起作用的是: 工作表ActiveSheet(或工作表(“数据”)包含从C14到Cend的行,其中包含从E14:Eend到R14:Rend的列,其中“end”标记由列C确定的最后一行数据。系列名称存储在第9行中。所有系列的X值都相同 我最大的问题是,我找不到一种方法来动态地将所有数据列作为序列添加到我的图表中,同时添加各自的名称。我不是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
示例代码
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
您可以在整个范围内迭代并不断添加更多系列谢谢您的帮助。我解决了这个问题。我似乎完全弄乱了单元格范围的符号。你不能使用
Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")
而是要用
Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))
此外,使用Charts.Add也没有多大帮助,因为Excel试图自动为所有系列找到正确的范围,并将它们相加,结果是一个完全混乱的图表。更好的方法是使用
Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)
因为这将创建一个完全空的图形,您可以向其中添加自己的系列
以下是所有感兴趣的人的完整且有效的代码:
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
它在哪里起作用,从哪一点起不起作用?该系列是否可能从系列0开始?因此,系列收集(i-1)?如果我没有弄错的话,您也可以将
与ActiveChart.SeriesCollection.NewSeries一起使用,并在下面几行中设置.xvalue等。然后用结束,用