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

Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
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

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