使用两个系列

时间:2017-12-15 05:47:33

标签: excel vba excel-vba

我想在Excel中使用宏创建40个不同的列堆叠图。每个图有两个系列。到目前为止,我已经做到了这一点:

Sub loopChart()

    Dim mychart As Chart
    Dim myRange As Range
    Dim c As Integer
    Dim d As Integer
    c = 1
    d = 2

    While c <= 33 '1=dataSource1, 4=dataSource2, 7=dataSource3
    While d <= 33
        'set data source for the next chart
        With Worksheets("Hoja1")
            Set myRange = .Range(.Cells(1, c), .Cells(3, c + 1))
            Set myRange2 = .Range(.Cells(1, d), .Cells(3, d + 1))
        End With

        'create chart
        Sheets("Hoja1").Select
        ActiveSheet.Shapes.AddChart.Select

        With ActiveChart
            .ChartType = xl3DColumnStacked
            'sets source data for graph including labels
            .SetSourceData Source:=myRange2, PlotBy:=xlColumns
            'including legend
            .SetElement (msoElementLegendRight)
            .HasTitle = True
            'dimentions & location:
            'defines the coordinates of the top of the chart
            .Parent.Top = 244
            'defines the coordinates for the left side of the chart
            .Parent.Left = c * 100
            .Parent.Height = 200
            .Parent.Width = 300
            .ChartTitle.Text = "Porcenta-2014"
        End With

        c = c + 3
        d = d + 3
    Wend
    Wend

End Sub

我想要 1 2 的图片我的图表使用了A列的名称:

image

1 个答案:

答案 0 :(得分:0)

Sub tset()

Dim dataRange As Range
Dim dataNames As Range
Dim c As Integer

Set dataRange = Range("B1:C3")
Set dataNames = Range("A2:A3")
c = 1

For i = 1 To 40
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
        .SetSourceData Source:=dataRange, PlotBy:=xlColumns
        .SeriesCollection(1).XValues = dataNames
        .ChartType = xl3DColumnStacked
        .SetElement (msoElementLegendRight)
        .HasTitle = True
        .Parent.Top = 244
        .Parent.Left = c * 100
        .Parent.Height = 200
        .Parent.Width = 300
        .ChartTitle.Text = "Porcenta-2014"
End With
c = c + 3
Set dataRange = dataRange.Offset(0, 2)
Next i

End Sub