Excel - 使用同一列生成多个系列折线图

Question

我有一个 VBA 脚本，用于在 Excel 中生成多个折线图。它曾经在每个图表中包含 2 个系列集合（从 2 列中读取），但后来我只修改了一个。但是现在我希望它再次执行 2 系列，但希望它从同一列中读取两个集合。这可能吗？

我已尝试修改 .SeriesCollection(2) 以转到列下方的下一个范围。但是，这只会返回错误 4001。

Sub CreateCharts()
    Dim ws As Worksheet
    Dim ch As Chart
    Dim NumCharts As Integer, ChartName As String, ChartTitle As String, i  As Integer

    Set ws = Sheets("Charts")

    NumCharts = WorksheetFunction.CountA(ws.Rows(2))

    For i = 2 To NumCharts Step 1 '1 column of data per chart
        ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
        ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
        Set ch = Charts.Add
        With ch
            .ChartType = xlLine
            .SetSourceData Source:=ws.Range(ws.Cells(3, i), ws.Cells(20, i)), _
            PlotBy:=xlColumns 'range of data for each chart
            .SeriesCollection(1).XValues = ws.Range("A3:A20") 'data range of line 1 (test data)
            .SeriesCollection(2).XValues = ws.Range("A21:A38") 'data range of line 2 (Rw curve)
            .Name = ChartName
            .HasTitle = True
            .ChartTitle.Characters.text = "#" & ws.Cells(2, i) '& " " & ws.Cells(1, i)  'remove title 'change to "ws.Cells(2, i)" to see titles
            .ChartTitle.Left = 600

            'HORiZONTAL X AXiS
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.text = "Frequency (Hz)"
            .Axes(xlCategory).MajorTickMark = xlNone
            .Axes(xlCategory).AxisBetweenCategories = False
            .Axes(xlCategory).Border.LineStyle = None

            'VERTiCAL Y AXiS
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.text = "Sound Reduction Index (dB)"
            .Axes(xlValue).TickLabels.NumberFormat = "0"
            .Axes(xlValue).MajorTickMark = xlNone
            .Axes(xlValue).HasMajorGridlines = False
            .Axes(xlValue).MinimumScale = 10 'minimum value on y
            .Axes(xlValue).MaximumScale = 80 'maximum value on y
            .Axes(xlValue).Border.LineStyle = None

            'LEGEND
            .HasLegend = False

            'FONT SPECiFiCATiONS
            .ChartArea.Format.TextFrame2.TextRange.Font.Size = 14
            .ChartArea.Format.TextFrame2.TextRange.Font.Name = "Myriad Pro"
            .ChartArea.Border.LineStyle = xlNone

            'CHART POSiTiON, SiZE & COLOUR
            .PlotArea.Format.Fill.ForeColor.RGB = RGB(242, 242, 242) 'grey background
            .PlotArea.Top = 0
            .PlotArea.Left = 20
            .PlotArea.Height = 440
            .PlotArea.Width = 420

            'CHART LiNE COLOURS
            .SeriesCollection(1).Border.Color = RGB(27, 117, 188) 'first line colour
            '.SeriesCollection(2).Border.Color = RGB(0, 0, 0) 'second line colour
            '.SeriesCollection(2).LineStyle = xlDashDot

        End With
    Next i

End Sub

这是我想要实现的图像示例。

Answer 1

根据我对目标的理解，对代码进行了轻微修改和测试（为每列创建一个 2 系列图表。第 1 系列第 3-20 行和第 2 系列第 21 至 38 行）。代码的唯一问题是缺少SeriesCollection(2)。修改为添加必要的SeriesCollection，如果存在自动添加的系列集合则删除。

For i = 2 To NumCharts Step 1 '1 column of data per chart
        ChartName = ws.Cells(2, i) '"chrt" & Range(Col1 & 2)
        ChartTitle = ws.Cells(2, i) 'Range(Col1 & 2)
        Set ch = Charts.Add

            'Delete if any automatically added series exist
            For x = ch.SeriesCollection.Count To 1 Step -1
            ch.SeriesCollection(x).Delete
            Next

        With ch
            .ChartType = xlLine
            .SeriesCollection.Add ws.Range(ws.Cells(3, i), ws.Cells(20, i))
            .SeriesCollection.Add ws.Range(ws.Cells(21, i), ws.Cells(38, i))
            .SeriesCollection(1).XValues = ws.Range(ws.Cells(3, 1), ws.Cells(20, 1))
            .SeriesCollection(2).XValues = ws.Range(ws.Cells(21, 1), ws.Cells(38, 1))

            .Name = ChartName