如何在 vba 中为此代码编写循环

Question

59.30   15                16                   17
1    1,162,912,036.90    1,248,737,016.99    1,306,573,912.08 
2    245,665,383.94      261,416,880.69      276,613,283.05 
3    393,313,441.29      379,169,039.15      418,680,492.19 
4    13,920,572.74       14,464,854.92       15,120,474.58 
5    54,501,581.55       56,319,351.21       58,832,588.24 
6    15,165,376.28       11,694,942.56       10,809,661.03 
7    194,397,643.30      170,427,013.85      182,567,862.46 
8    15,165,376.28       11,694,942.56       10,809,661.03 
9    2,079,876,036.00    2,142,229,099.38    2,269,198,273.62
     3%                  6%

在不同区域的一个excel选项卡中有7个类似上述数据的表格。我想为每个表格创建一个堆积柱形图。我写了一个代码来创建。只是想知道是否可以使用循环来解决这个问题？附上代码。

子格式ChartNIX() '目的：创建图表（图表维度不是必需的）

Dim rng As Range
Dim cht As Object
Dim ser As Series
Dim tmpCHR As ChartObject

'Chart1
        'Your data range for the chart
          Set rng = ActiveSheet.Range("B8:E17")

        'Create a chart
          Set cht = ActiveSheet.Shapes.AddChart

        'Give chart some data
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows

        'Determine the chart type
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(1).Top = .Range("C24").Top
         .ChartObjects(1).Left = .Range("C24").Left
         End With
        ActiveSheet.ChartObjects(1).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("c1")

'Chart2
           Set rng = ActiveSheet.Range("G8:J17")
          Set cht = ActiveSheet.Shapes.AddChart
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(2).Top = .Range("H24").Top
         .ChartObjects(2).Left = .Range("H24").Left
         End With
         ActiveSheet.ChartObjects(2).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("h1")
'Chart3
           Set rng = ActiveSheet.Range("L8:o17")
          Set cht = ActiveSheet.Shapes.AddChart
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(3).Top = .Range("M24").Top
         .ChartObjects(3).Left = .Range("M24").Left
         End With
         ActiveSheet.ChartObjects(3).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("h1")
'Chart4
           Set rng = ActiveSheet.Range("B82:E91")
          Set cht = ActiveSheet.Shapes.AddChart
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(4).Top = .Range("C51").Top
         .ChartObjects(4).Left = .Range("C51").Left
         End With
                   ActiveSheet.ChartObjects(4).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("c75")
 'Chart5
           Set rng = ActiveSheet.Range("G82:J91")
          Set cht = ActiveSheet.Shapes.AddChart
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(5).Top = .Range("H51").Top
         .ChartObjects(5).Left = .Range("H51").Left
         End With
                   ActiveSheet.ChartObjects(5).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
 ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("h75")

'Chart6
           Set rng = ActiveSheet.Range("L82:o91")
          Set cht = ActiveSheet.Shapes.AddChart
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(6).Top = .Range("M51").Top
         .ChartObjects(6).Left = .Range("M51").Left
         End With
                   ActiveSheet.ChartObjects(6).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
 ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("m75")
 'Chart7
           Set rng = ActiveSheet.Range("Q82:T91")
          Set cht = ActiveSheet.Shapes.AddChart
          cht.chart.SetSourceData Source:=rng, PlotBy:=xlRows
          cht.chart.ChartType = xlColumnStacked
        With ActiveSheet
         .ChartObjects(7).Top = .Range("R51").Top
         .ChartObjects(7).Left = .Range("R51").Left
         End With
                   ActiveSheet.ChartObjects(7).Activate
ActiveChart.Axes(xlValue).Select
Selection.delete
 ActiveChart.HasTitle = True
ActiveChart.ChartTitle.Text = ActiveSheet.Range("r75")

End Sub

Answer 1

使用命名范围和一些数组，您可以遍历它。 首先，为每个图表的范围创建命名范围。

我在电子表格中添加了一个小表格，并将每个表格命名为该范围的第一个单元格中的文本（即 Chart1，... Chart7）。其他范围每个都在下一个单元格中，因此名为“图表 1”的范围是 4 个单元格。

（我还使用了您在上面代码中使用的相同范围和单元格）

图 1 B8:E17 C24 C1
图2 G8:J17 H24 H1
图 3 L8:O17 M24 H1
图4 B82:E91 C51 C75
图5 G82:J91 H51 H75
图6 L82:O91 M51 R75
图7 Q82:T91 R51 R75

Sub FormatChartNIX_Modified()

Dim rng As Range
Dim cht As Object
Dim ser As Series
Dim tmpCHR As ChartObject
Dim MyArray(1 To 7, 0 To 3) As String
Dim i As Integer


For i = LBound(MyArray) To UBound(MyArray)
        'Set Values - possibly with named ranges
        Dim vArray() As Variant
        Dim strNamedRange As String

        strNamedRange = "Chart" & i

        Set rng = Worksheets("Sheet1").Range(strNamedRange)
        vArray = rng

        Dim j As Integer

        For j = LBound(MyArray, 2) To UBound(MyArray, 2)

            MyArray(i, j) = vArray(1, j + 1)
            Debug.Print MyArray(i, j)

        Next j

    Next i

    For i = LBound(MyArray) To UBound(MyArray)

            With ActiveSheet
                Set rng = .Range(MyArray(i, 1))                     '1 represents the data range
                Set cht = .Shapes.AddChart
                cht.Chart.SetSourceData Source:=rng, PlotBy:=xlRows
                cht.Chart.ChartType = xlColumnStacked

                .ChartObjects(i).Top = .Range(MyArray(i, 2)).Top    '0 represents the chart name
                .ChartObjects(i).Left = .Range(MyArray(i, 2)).Left  '2 represents the cell identifying the chart location
                .ChartObjects(i).Activate
                With ActiveChart
                .Axes(xlValue).Select
                .Axes(xlValue).Delete
                .HasTitle = True
                .ChartTitle.Text = ActiveSheet.Range(MyArray(i, 3)).Text '3 represents the cell where the title text is located
                End With
            End With
    Next i

End Sub

执行此操作，运行 sub，它将创建 7 个图表，如表中所述 - 使用循环。