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

Excel VBA Script to dynamically add series to chart

提问by chross

I'm trying to dynamically add multiple series to a line chart. I don't know beforehand how many series there are so it needs to be dynamic. What I've come up with but doesn't work is the following:

我正在尝试将多个系列动态添加到折线图。我事先不知道有多少系列，所以它需要是动态的。我想出但不起作用的是以下内容：

The sheet ActiveSheet (or Sheets("Data")) has Rows from C14 until Cend containing the XValues and Columns from E14:Eend until R14:Rend where "end" marks the last row of data as determined by column C. The series names are stored in row 9. XValues are the same for all series.

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

My big problem is, that I can't find a way to dynamically add all the data columns as series to my chart together with the respective name. I'm not an expert in VBA so please be kind. I already read various sources and tried many scripts, none seem to work. The Object Catalogue was a bit of a help, however my problem persists.

我的大问题是，我找不到一种方法将所有数据列作为系列与各自的名称一起动态添加到我的图表中。我不是 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

回答by chross

thanks for the help. I solved the problem. It seems as I have somehow completely messed up the notation of the cell range. You cannot use

谢谢您的帮助。我解决了这个问题。似乎我以某种方式完全弄乱了单元格范围的符号。你不能使用

Set xRng = Sheets("Data").Range("R14:C3", "R" & LastRow & ":C3")

But rather have to use

而是必须使用

Set xRng = .Range(.Cells(14, 3), .Cells(LastRow, 3))

Also, the use of Charts.Add didnt help very much as Excel tries to automatically find the correct ranges for all series and adds them resulting in a completely messed up chart. A better way was to use

此外，使用 Charts.Add 并没有太大帮助，因为 Excel 试图自动找到所有系列的正确范围并将它们添加到一个完全混乱的图表中。更好的方法是使用

Set ChartObj = ActiveSheet.ChartObjects.Add(Left:=20, Width:=800, Top:=20, Height:=500)

As this will create a completely empty graph to which you can add your own series

因为这将创建一个完全空的图表，您可以在其中添加您自己的系列

Here is the complete and working code for anyone interested:

这是任何感兴趣的人的完整且有效的代码：

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

回答by chross

sample code

示例代码

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

you can iterate over range and keep adding more series

您可以遍历范围并不断添加更多系列