Question

我有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循环或任何其他循环以最小化代码的长度。我是新来的，所以找不到解决方案。

Answer 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

Answer 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）不同

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

2 个答案: