Excel VBA Script để tự động thêm chuỗi vào biểu đồ

Question

Tôi đang cố gắng thêm động nhiều chuỗi vào biểu đồ dạng đường. Tôi không biết trước bao nhiêu series có nên nó cần phải năng động. Những gì tôi đã đưa ra nhưng không hoạt động như sau:

Trang tính ActiveSheet (hoặc Trang tính ("Dữ liệu") có Hàng từ C14 cho đến khi Cend chứa XValues ​​và Cột từ E14: Eend cho đến R14: Hiển thị ở đâu "cuối" đánh dấu hàng cuối cùng của dữ liệu được xác định theo cột C. Tên chuỗi được lưu trữ trong hàng 9. XValues ​​giống nhau cho tất cả các chuỗi.

Vấn đề lớn của tôi là, tôi không thể tìm cách thêm động tất cả các cột dữ liệu dưới dạng chuỗi vào biểu đồ cùng với tên tương ứng. Tôi không phải là một chuyên gia trong VBA vì vậy hãy tử tế. Tôi đã đọc nhiều nguồn khác nhau và đã thử nhiều kịch bản, dường như không có tác phẩm nào. Danh mục đối tượng là một chút trợ giúp, tuy nhiên vấn đề của tôi vẫn tồn tại.

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

mẫu mã

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 

bạn có thể lặp lại trên phạm vi và tiếp tục bổ sung hàng loạt hơn

Answer 2

cảm ơn vì sự giúp đỡ. Tôi giải quyết vấn đề. Có vẻ như tôi đã bằng cách nào đó hoàn toàn sai lầm ký hiệu của dãy ô. Bạn không thể sử dụng

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

Nhưng thay vì phải sử dụng

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

Ngoài ra, việc sử dụng các Charts.Add didnt giúp rất nhiều như Excel sẽ tự động tìm các dãy chính xác cho tất cả các series và thêm chúng kết quả trong một biểu đồ hoàn toàn sai lầm. Cách tốt hơn là sử dụng

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

Như này sẽ tạo ra một đồ thị hoàn toàn trống rỗng mà bạn có thể thêm hàng loạt của riêng bạn

Đây là mã hoàn chỉnh và làm việc cho bất cứ ai quan tâm:

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