如何在Excel VBA宏中循环绘制图表

3

我试图使用Excel VBA循环绘制散点图,但是不知道如何实现。

这是我使用RAND()函数填充Y序列生成的虚拟数据,并且下面的图片展示了一个示例图表。

enter image description here

以下是相应的代码:

Sub multichart()
    Range("A1:B21").Select
    Charts.Add
    ActiveChart.ChartType = xlXYScatter
    ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("A1:B21"), PlotBy _
        :=xlColumns
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Y1"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
    ActiveSheet.Shapes("Chart 6").ScaleHeight 0.61, msoFalse, msoScaleFromTopLeft
    ActiveChart.PlotArea.Select
    Selection.Top = 1
    Selection.Height = 106
    Selection.Height = 113
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With
End Sub

我希望可以循环执行此过程以创建N个图表(其中N是任何工作表中Y列的数量),这意味着每个工作表的变化不同。还需要将图表逐一追加。为了进行比较,所有绘图的Y和X限制应该是相同的。输出结果如下所示(仅展示4个变量): enter image description here 抱歉可能这是一个基础问题,因为我是Excel VBA的初学者。
1个回答

3
您没有说明使用的 Excel 版本,以下方法适用于 2010 版本,其他版本也应该可以使用。但是我不是 VBA 图表专家。希望变量名称可以自解释:
Sub multichart()
Dim ws As Excel.Worksheet
Dim i As Long
Dim cht As Chart
Dim cho As ChartObject
Dim TitleRange As Excel.Range
Dim DataRange As Excel.Range
Dim ChartHeight As Long
Dim LastCol As Long
Dim LastRow As Long
Dim MaxAmountToChart

Set ws = ActiveSheet
'delete the old ones
For Each cho In ws.ChartObjects
    cho.Delete
Next
ChartHeight = 20
With ws
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    MaxAmountToChart = Application.WorksheetFunction.Max(ws.Range(ws.Cells(1, 2), .Cells(LastRow, LastCol)))
    Set TitleRange = .Range("A1:A" & LastRow)
    For i = 2 To LastCol
        Set DataRange = .Range(.Cells(1, i), .Cells(LastRow, i))
        Set cht = Charts.Add
        cht.Location Where:=xlLocationAsObject, Name:=.Name
        Set cho = .ChartObjects(.ChartObjects.Count)
        cho.Top = (i - 1) * ChartHeight * .Rows(1).RowHeight
        cho.Left = 0
        Set cht = cho.Chart
        '.Shapes(cht.Name).ScaleHeight 0.61, msoFalse, msoScaleFromTopLeft
        With cht
            .ChartType = xlXYScatter
            .SetSourceData Source:=Union(TitleRange, DataRange), PlotBy:=xlColumns
            .HasTitle = True
            .ChartTitle.Characters.Text = "Y1"
            .Axes(xlCategory, xlPrimary).HasTitle = False
            .Axes(xlValue, xlPrimary).MaximumScale = MaxAmountToChart
            With .PlotArea
                .Top = 1
                .Height = 106
                .Height = 113
                With .Border
                    .ColorIndex = 16
                    .Weight = xlThin
                    .LineStyle = xlContinuous
                End With
                With .Interior
                    .ColorIndex = 2
                    .PatternColorIndex = 1
                    .Pattern = xlSolid
                End With
            End With
        End With
    Next i
End With
End Sub

非常感谢您的回答。我在Excel 2003、2007和2013中进行了测试,但没有在2010中进行测试(您已经测试过了)。 (1) 我认为仍需要调整对齐方式,通常情况下图形不会像图中那样紧密排列 - 但是在图形之间放置一些恒定的间隙,并按所需的单列排列。 (2) 图的标题始终是工作表中的第一个变量。如果不是微不足道的问题,我不会担心解决此问题。 - jon
不客气。你还需要我做些什么吗?我的一般建议是接受这个答案,并尝试自己调整它以实现你想要的效果。 - Doug Glancy

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接