2013-10-09 136 views
6

我試圖動態添加多個系列到折線圖。事前我不知道有多少系列,所以它需要動態。我提出的但不起作用的是:Excel VBA腳本動態添加系列到圖表

工作表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 
+0

至於它在哪裏工作,從哪一點起不起作用? –

+0

該系列可能是從系列0開始的?因此SeriesCollection(i-1)? 如果我沒有弄錯,你也可以使用'With ActiveChart.SeriesCollection.NewSeries',並在下面的行中設置.XValues等。然後用'End With'關閉 –

回答

4

示例代碼

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 

你可以遍歷範圍,並不斷添加更多的系列

9

感謝您的幫助。我解決了這個問題。這似乎是我完全搞砸了單元格區域的符號。不能使用

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