VBA批量画折线图的问题

俊小鸭

各位高手，本人最近有一个需求，需要根据动态数据批量画出折线图进行分析。

大致介绍一下：
有3组数据，其中每4条数据作为一个组，循环套那种，比如数据：1，2，3，4，5，6，那么，1234为一组，2345为一组，3456为一组，分别编号为1234为组1，2345为组2，3456为组3，要求如下：
1. 按列画折线图，每组数据一共有3列，第一列作为x轴数据，第二列和第三列，作为系列1和系列2
2. 图表标题要求为组号，例如，1234组数据画出来的折线图标题为1，2345组数据画出来的折线图标题为2，以此类推
3. 数据是动态的，意味着，当数据源变动的时候，组的数量也会发生变化，那么要求VBA设计的时候，图的数量和组的数量必须要随着数据源的变动而进行对应的变化。类似下图，右边是我手动画的图，也是我期望能画出来的效果。左边的图是我自己写的VBA做出来的图，数据源和x轴以及系列的设定都已经实现，但是有两个问题，第一，图表标题我做不到。具体原因我也清楚，但是不知如何解决，第二，VBA画的图只能画到第39组数据，后面的出不来。不知道为什么。




参考论坛大佬们以前的类似问题的回答，我自己参考写了一个VBA。

Option Explicit

Sub AddChart()
    Dim i
    For i = 2 To Sheets("图形分析-4").Range("$E$2").Value
        Charts.Add
        '增加一个图表
        ActiveChart.ChartType = xlLine
        '设置图表类型为折线图
        ActiveChart.Location Where:=xlLocationAsObject, Name:="图形分析-4"
        '设置图表的位置为当前工作表中
        ActiveChart.SetSourceData Source:=Sheets("图形分析-4").Range("H" & i & ":J" & i + 3), PlotBy:=xlColumns
        '设置图表的数据源
        ActiveChart.FullSeriesCollection(1).XValues = "='图形分析-4'!$H$" & i & ":$H$" & i + 3
        ActiveChart.FullSeriesCollection(3).Delete
        ActiveChart.FullSeriesCollection(1).Values = "='图形分析-4'!$I$" & i & ":$I$" & i + 3
        ActiveChart.FullSeriesCollection(2).Values = "='图形分析-4'!$J$" & i & ":$J$" & i + 3
        ActiveChart.Legend.Select
        Selection.Delete
        '删除图例
        ActiveChart.SetElement (msoElementChartTitleAboveChart)
        '添加图表标题位于图表上方
        ActiveChart.ChartTitle.Select
        ActiveChart.ChartTitle.Text = i
        '设置图表标题为对应组号
        ActiveChart.Parent.Top = 220 * (i - 2) / 4
        '设置图表的上下间隔为220磅
        ActiveChart.Parent.Left = 456
        '设置图表距左为456磅
    Next i
End Sub

Sub DelChart()
    Dim ch As ChartObject
    For Each ch In ActiveSheet.ChartObjects
        ch.Delete
        '删除图表对象
    Next
End Sub


这里，图表标题的问题我知道。直接赋值为i，肯定不对，我也尝试过添加一个参数n，将n赋值给图表标题，然后n=n+1，放在i的循环外面，再循环n，结果一运行就死机。估计循环锁了。
至于图表标题的数量，如果用以上的VBA运行，只能画到39组，
我尝试过把i的值改为：i = 2 To Sheets("图形分析-4").Range("$E$2").Value * 4，但是会报错，我估计是i+3的值超过了范围，
但是假如说，i = 2 To Sheets("图形分析-4").Range("$E$2").Value*3 就不会报错，但是也只能画到116组，很奇怪
我用的是office2019，所以有些对象名可能不一样，不过这个不重要。

还有一些细节，比如设定折线图Y轴的固定刻度之类的，那些不重要，我自己去找资料。

求大佬指点以下2个问题
1. 如何把图表的标题按组号顺序生成
2. 完整的画完所有组别的图。

请查看附件

蓝桥玄霜

图表的例子：

1. Sub AddChart()
   
2.     Dim i%, Myr%, ht, tp, lf, wd, myChart, n%
   
3.     Sheet14.Activate
   
4.     Myr = Cells(Rows.Count, 7).End(xlUp).Row
   
5.     ht = [a1].Resize(15, 1).Height
   
6.     wd = [a1].Resize(1, 7).Width
   
7.     lf = [j1].Left
   
8.     For i = 1 To Cells(Myr, 7).Value Step 4
   
9.         n = n + 1
   
10.         tp = Cells(15 * n - 14, 1).Top
    
11.         Set myChart = ActiveSheet.ChartObjects.Add _
    
12.                     (Left:=lf, Top:=tp, _
    
13.                     Width:=wd, Height:=ht)
    
14.         '增加一个图表
    
15.         With myChart.Chart
    
16.             .ChartType = xlLine
    
17.             '设置图表类型为折线图
    
18.             .SetSourceData Source:=Range("H" & i + 1 & ":J" & i + 4), PlotBy:=xlColumns
    
19.             '设置图表的数据源
    
20.             .FullSeriesCollection(1).XValues = "='图形分析-4'!$H$" & i + 1 & ":$H$" & i + 4
    
21.             .FullSeriesCollection(1).Values = "='图形分析-4'!$I$" & i + 1 & ":$I$" & i + 4
    
22.             .FullSeriesCollection(2).Values = "='图形分析-4'!$J$" & i + 1 & ":$J$" & i + 4
    
23.             .Legend.Delete
    
24.             .Axes(xlValue).Format.Line.Visible = msoFalse
    
25.             '删除图例
    
26.             .SetElement (msoElementChartTitleAboveChart)
    
27.             '添加图表标题位于图表上方
    
28.             .ChartTitle.Text = Cells(i + 1, 7).Value
    
29.             '设置图表标题为对应组号
    
30.         End With
    
31.     Next
    
32. End Sub

复制代码

俊小鸭

我在我自己的excel里面运行了一下。结果报错。



不知道是不是office版本的原因，我的是office2019

俊小鸭

蓝桥玄霜 发表于 2021-10-14 09:42
图表的例子：

蓝版好，运行时报错，下面我有列出截图。麻烦看看是不是版本的问题。
另外，你的代码我看了，有好几个地方看不懂，我准备自己查资料学习一下你代码里面不懂的部分。重点是学习你的思路。

蓝桥玄霜

应该不是版本的问题。你可以查看Myr=？，G列有数据的？

俊小鸭

蓝桥玄霜 发表于 2021-10-15 09:09
应该不是版本的问题。你可以查看Myr=？，G列有数据的？

这也是我奇怪的地方，G列没有数据，是空列，间隔用的。

zuoming368

收藏了，怎么删除呢