Как подать заявку на цикл для создания диаграмм с помощью vba

У меня 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 или любой другой, чтобы минимизировать длину кода. Я здесь новичок, поэтому не нашел для этого никакого решения.

1
0
52
2

Ответы 2

Вы можете попробовать что-то вроде этого: Поскольку единственная разница между вашими графиками - это диапазон, который вы выбираете.

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

это может быть что-то вроде:

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, есть отзывы?

DisplayName 11.08.2018 18:19

@DispalyName: Спасибо. Этот код работает нормально, но есть некоторые проблемы, и я получил ошибку 1004. Моя вторая и последняя опорные точки имеют только два уровня данных ... Итак, при выборе диапазона для этого диапазона он не нашел никакого диапазона, и появится ошибка 1004. Как решить эту проблему?

Shaon 15.08.2018 12:50

Это совершенно другая проблема, чем та, для которой вы начали эту тему. Если мой ответ решил ваш вопрос, отметьте его как принятый и создайте новую тему для нового выпуска. Спасибо

DisplayName 15.08.2018 15:07

Другие вопросы по теме