web-dev-qa-db-ja.com

チャートにシリーズを動的に追加するExcel VBAスクリプト

複数のシリーズを折れ線グラフに動的に追加しようとしています。シリーズがいくつあるかは事前にはわからないので、動的にする必要があります。私が思いついたのにうまくいかないのは次のとおりです：

シートActiveSheet（またはSheets（ "Data"））には、C14からC14までの行があり、E14：EendからR14：RendまでのXValuesおよびColumnsが含まれます。行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
excelvbachartsdynamically-generated
8
chross

助けてくれてありがとう。問題を解決しました。どうやらセル範囲の表記を完全に台無しにしてしまったようです。使用できません

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
13
chross

サンプルコード

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

範囲を反復して、さらにシリーズを追加し続けることができます

6
user2140173