Question

我记录了宏以运行图表，该系列不是我期望的它正在改变图表中的系列和类别

    Sub Macro13()

 ' Macro13 Macro
 '
 ' Keyboard Shortcut: Ctrl+b
 Dim myString As String
myString = Selection.Address
ActiveSheet.Shapes.AddChart2(227, xlLineMarkers).Select
ActiveChart.SetSourceData Source:=Range(myString),PlotBy:=xlRows
ActiveChart.Legend.Select
Selection.Delete
End Sub

当我删除图表并运行宏时。得到以下图表

但想要以下图表

月份-年份应在x轴（类别）上，序列应为0、1、2、3等。以下数据是

series  Sep-10  Oct-10  Nov-10  Dec-10  Jan-11  Feb-11
0   7   8   90  80  110 1
1   5   1   18  36  97  1
2   5   1   18  36  97  1
3   5   1   18  36  97  1
4   5   1   18  36  97  1
5   5   1   18  36  97  1
6   5   1   18  36  97  1
7   5   1   18  36  100 1
8   5   1   18  40  97  1
9   5   7   18  36  97  1
10  5   1   89  36  97  1
11  5   1   18  36  97  1
12  5   1   18  36  97  1
 ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$G$14") 'was changed to 
ActiveChart.SetSourceData Source:=Range("Sheet1!$A$1:$G$14"), PlotBy:=xlRows then it added the series name to it but got like this with series included in x-axis

当我录制宏时，这是我选择并删除图例的图表。

Answer 1

尝试一下。

Sub test()
    Dim obj As ChartObject, Cht As Chart
    Dim Ws As Worksheet
    Dim Srs As Series
    Dim rngDB As Range, rngHead As Range
    Dim rng As Range

    Set Ws = ActiveSheet
    With Ws
        Set rngHead = .Range("b1", "g1")
        Set rngDB = .Range("a2", "a14")
    End With
    Set obj = Ws.ChartObjects.Add(400, 200, 600, 400)
    Set Cht = obj.Chart
    With Cht
        .HasLegend = False
        .HasTitle = True
        .ChartType = xlLineMarkers
        With .ChartTitle
            .Characters.Text = "Chart Title"
            .Characters.Font.Size = 12
        End With
        For Each rng In rngDB
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .Name = rng
                .XValues = rngHead
                .Values = rng.Offset(, 1).Resize(1, 6)
            End With
        Next rng
    End With
End Sub

关于根据动态范围形成的图表。

Sub setChart()
    Dim obj As ChartObject, Cht As Chart
    Dim Ws As Worksheet
    Dim Srs As Series
    Dim rngDB As Range, rngHead As Range
    Dim rng As Range
    Dim rngChart As Range
    Dim r As Integer, c As Integer

    Set Ws = ActiveSheet
    Set rngChart = Selection
    r = rngChart.Rows.Count - 1
    c = rngChart.Columns.Count - 1
    If r < 1 Or c < 1 Then
        MsgBox "set the range correctly!"
        Exit Sub
    End If


    With rngChart
        Set rngHead = .Range("b1").Resize(1, c)
        Set rngDB = .Range("a2").Resize(r)
    End With
    Set obj = Ws.ChartObjects.Add(400, 200, 600, 400)
    Set Cht = obj.Chart
    With Cht
        .HasLegend = False
        .HasTitle = True
        .ChartType = xlLine
        With .ChartTitle
            .Characters.Text = "Chart Title"
            .Characters.Font.Size = 12
        End With
        For Each rng In rngDB
            Set Srs = .SeriesCollection.NewSeries
            With Srs
                .Name = rng
                .XValues = rngHead
                .Values = rng.Offset(, 1).Resize(1, c)
            End With
        Next rng
    End With
End Sub

Answer 2

确保左上角的单元格为空

开始记录您的宏
选择数据范围

插入您选择的图形样式

右键单击图形并选择“选择数据。”

左键单击“切换行/列”按钮

根据您的喜好设置图表格式
将文本添加到左上角

停止录制

Excel VBA图表-在拆分系列以创建多个系列时遇到问题

2 个答案: