Excel VBA脚本动态添加系列到图表

Question

我试图动态添加多个系列到折线图。事前我不知道有多少系列，所以它需要动态。我提出的但不起作用的是：

工作表ActiveSheet（或Sheets（“Data”））从C14开始具有行，直到包含从E14：Eend到R14的XValues和Columns的Cend： Rend其中“end”标记由列C确定的最后一行数据。系列名称存储在第9行。XValues对于所有系列都是相同的。

我的大问题是，我无法找到一种方法来将所有数据列作为系列动态添加到我的图表以及相应的名称。我不是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 

Answer 1

示例代码

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 

你可以遍历范围，并不断添加更多的系列

Answer 2

感谢您的帮助。我解决了这个问题。这似乎是我完全搞砸了单元格区域的符号。不能使用

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