如何申请循环使用VBA创建图表答案

【问题标题】：How to apply for loop to create charts using VBA如何申请循环使用VBA创建图表
【发布时间】：2018-08-10 12:25:42
【问题描述】：

我有 14 个数据透视表。我想为所有 14 个表创建图表。我的代码如下所示，看起来很连贯。我想在这里申请循环。我的代码如下：

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B5:E5").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$3:$E$5")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht1 As Shape
    Set cht1 = ActiveSheet.Shapes(1)
    cht1.Name = "chart001"
    ActiveSheet.ChartObjects("chart001").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart001").Width = 288
    ActiveSheet.Shapes("chart001").LockAspectRatio = msoTrue




    Range("B12:D12").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$10:$D$12")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht2 As Shape
    Set cht2 = ActiveSheet.Shapes(1)
    cht2.Name = "chart002"
    ActiveSheet.ChartObjects("chart002").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels

    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart002").Width = 288
    ActiveSheet.Shapes("chart002").LockAspectRatio = msoTrue


    Range("B19:E19").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$17:$E$19")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht3 As Shape
    Set cht3 = ActiveSheet.Shapes(1)
    cht3.Name = "chart003"
    ActiveSheet.ChartObjects("chart003").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart003").Width = 288
    ActiveSheet.Shapes("chart003").LockAspectRatio = msoTrue


    Range("B26:E26").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$24:$E$26")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht4 As Shape
    Set cht4 = ActiveSheet.Shapes(1)
    cht4.Name = "chart004"
    ActiveSheet.ChartObjects("chart004").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart004").Width = 288
    ActiveSheet.Shapes("chart004").LockAspectRatio = msoTrue


    Range("B33:E33").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$31:$E$33")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht5 As Shape
    Set cht5 = ActiveSheet.Shapes(1)
    cht5.Name = "chart005"
    ActiveSheet.ChartObjects("chart005").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart005").Width = 288
    ActiveSheet.Shapes("chart005").LockAspectRatio = msoTrue


    Range("B40:E40").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$38:$E$40")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht6 As Shape
    Set cht6 = ActiveSheet.Shapes(1)
    cht6.Name = "chart006"
    ActiveSheet.ChartObjects("chart006").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart006").Width = 288
    ActiveSheet.Shapes("chart006").LockAspectRatio = msoTrue


    Range("B47:E47").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$45:$E$47")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht7 As Shape
    Set cht7 = ActiveSheet.Shapes(1)
    cht7.Name = "chart007"
    ActiveSheet.ChartObjects("chart007").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart007").Width = 288
    ActiveSheet.Shapes("chart007").LockAspectRatio = msoTrue


    Range("B54:E54").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$52:$E$54")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht8 As Shape
    Set cht8 = ActiveSheet.Shapes(1)
    cht8.Name = "chart008"
    ActiveSheet.ChartObjects("chart008").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart008").Width = 288
    ActiveSheet.Shapes("chart008").LockAspectRatio = msoTrue


    Range("B59:E59").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("Pivot!$A$59:$E$61")
    ActiveChart.ShowValueFieldButtons = False
    Dim cht9 As Shape
    Set cht9 = ActiveSheet.Shapes(1)
    cht9.Name = "chart009"
    ActiveSheet.ChartObjects("chart009").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart009").Width = 288
    ActiveSheet.Shapes("chart009").LockAspectRatio = msoTrue
End Sub

我有 14 个不同的数据透视表。现在如何应用 for 循环或任何其他循环来最小化代码的长度。我是新来的，所以没有找到任何解决方案。

【问题讨论】：

标签： vba excel for-loop charts

【解决方案1】：

你可以试试这样的：由于您的图表之间的唯一区别是您选择的范围。

Sub test()

Dim k, i As Integer

i = 0

For k = 1 To 12

Range(Cells(5 + i * 7, 2 + i * 7), Cells(5 + i * 7, 5 + i * 7)).Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range(Sheets("Pivot").Cells(1, 3), Sheets("Pivot").Cells(5 + i * 7, 5 + i * 7))
    ActiveChart.ShowValueFieldButtons = False
    Dim cht1 As Shape
    Set cht1 = ActiveSheet.Shapes(1)
    cht1.Name = "chart00" & k
    ActiveSheet.ChartObjects("chart00" & k).Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveChart.SeriesCollection(1).ApplyDataLabels
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ApplyDataLabels
    ActiveChart.SeriesCollection(3).Select
    ActiveChart.SeriesCollection(3).ApplyDataLabels
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("chart00" & k).Width = 288
    ActiveSheet.Shapes("chart00" & k).LockAspectRatio = msoTrue

i = 0 + 1
Next k

End Sub

【讨论】：

【解决方案2】：

可能是这样的：

Sub Macro1()
    Dim i As Long
    For i = 0 To 13
        Range("B5:E5").Offset(i * 7).Select
        With ActiveSheet.Shapes.AddChart
            With .Chart
                .ChartType = xlColumnClustered
                .SetSourceData Source:=Range("Pivot!$A$3:$E$5").Offset(i * 7)
                .SeriesCollection(1).ApplyDataLabels
                .SeriesCollection(2).ApplyDataLabels
                .SeriesCollection(3).ApplyDataLabels
                .ShowValueFieldButtons = False
            End With
            .Name = "chart" & Format(i + 1, "000")
            .Width = 288
            .LockAspectRatio = msoTrue
        End With
    Next
End Sub

您的代码中的第二个范围与所有其他列模式不同（B:D 和 A:D 而不是 B:E 和 A:E）

【讨论】：

@Shaon，有什么反馈吗？
@DispalyName：谢谢。此代码工作正常，但存在一些问题，我收到 1004 错误。我的第二个也是最后一个枢轴只有两个数据级别。
这是一个与您开始本主题时完全不同的问题。如果我的回答解决了您的问题，请将其标记为已接受并为新问题启动新主题。谢谢