使用 VBA 的 Excel 堆积面积图

Question

我正在尝试复制在以下站点中找到的结果：http://peltiertech.com/?s=variable+column

唯一的区别是我只想使用 VBA 代码来完成最终结果。我想避免引用工作表上的任何字段。最终结果创建具有可变宽度的列。我已确认网站上描述的过程在使用工作表上的数据时有效。我只是无法通过仅使用代码来获得相同的结果。

这是我目前所拥有的：

Sub RangeTest()

Dim MyArray1(1 To 14) As Variant
Dim MyArray2(1 To 14) As Variant
Dim MyArray3(1 To 14) As Variant
Dim MyArray4(1 To 14) As Variant
Dim MyArray5(1 To 14) As Variant

    MyArray1(1) = 0
    MyArray1(2) = 0
    MyArray1(3) = 12.5
    MyArray1(4) = 25
    MyArray1(5) = 25
    MyArray1(6) = 50
    MyArray1(7) = 75
    MyArray1(8) = 75
    MyArray1(9) = 112.5
    MyArray1(10) = 150
    MyArray1(11) = 150
    MyArray1(12) = 200
    MyArray1(13) = 250
    MyArray1(14) = 250

    MyArray2(1) = 0
    MyArray2(2) = 100
    MyArray2(3) = 100
    MyArray2(4) = 100
    MyArray2(5) = 0
    MyArray2(6) = 0
    MyArray2(7) = 0
    MyArray2(8) = 0
    MyArray2(9) = 0
    MyArray2(10) = 0
    MyArray2(11) = 0
    MyArray2(12) = 0
    MyArray2(13) = 0
    MyArray2(14) = 0

    MyArray3(1) = 0
    MyArray3(2) = 0
    MyArray3(3) = 0
    MyArray3(4) = 0
    MyArray3(5) = 75
    MyArray3(6) = 75
    MyArray3(7) = 75
    MyArray3(8) = 0
    MyArray3(9) = 0
    MyArray3(10) = 0
    MyArray3(11) = 0
    MyArray3(12) = 0
    MyArray3(13) = 0
    MyArray3(14) = 0

    MyArray4(1) = 0
    MyArray4(2) = 0
    MyArray4(3) = 0
    MyArray4(4) = 0
    MyArray4(5) = 0
    MyArray4(6) = 0
    MyArray4(7) = 0
    MyArray4(8) = 50
    MyArray4(9) = 50
    MyArray4(10) = 50
    MyArray4(11) = 0
    MyArray4(12) = 0
    MyArray4(13) = 0
    MyArray4(14) = 0

    MyArray5(1) = 0
    MyArray5(2) = 0
    MyArray5(3) = 0
    MyArray5(4) = 0
    MyArray5(5) = 0
    MyArray5(6) = 0
    MyArray5(7) = 0
    MyArray5(8) = 0
    MyArray5(9) = 0
    MyArray5(10) = 0
    MyArray5(11) = 25
    MyArray5(12) = 25
    MyArray5(13) = 25
    MyArray5(14) = 0

ActiveSheet.ChartObjects.Add(Left:=10, Width:=900, Top:=265, Height:=245).Name = "Testing1"

ActiveSheet.ChartObjects("Testing1").Chart.ChartType = xlAreaStacked
ActiveSheet.ChartObjects("Testing1").Chart.Axes(xlCategory).CategoryType = xlTimeScale

        With ActiveSheet.ChartObjects("Testing1").Chart
            .SeriesCollection.NewSeries
            .SeriesCollection(1).XValues = MyArray1
            .SeriesCollection(1).Values = MyArray2
            .SeriesCollection(1).Name = "Alpha"
            .SeriesCollection.NewSeries
            .SeriesCollection(2).XValues = MyArray1
            .SeriesCollection(2).Values = MyArray3
            .SeriesCollection(2).Name = "Beta"
            .SeriesCollection.NewSeries
            .SeriesCollection(3).XValues = MyArray1
            .SeriesCollection(3).Values = MyArray4
            .SeriesCollection(3).Name = "Gamma"
            .SeriesCollection.NewSeries
            .SeriesCollection(4).XValues = MyArray1
            .SeriesCollection(4).Values = MyArray5
            .SeriesCollection(4).Name = "Delta"
        End With

End Sub

这会创建图表，但不会转换为可变列宽。

Answer 1

你没有说出了什么问题。

我并没有对您的代码进行太多改动，只是重新排列它以使其更具可读性并且可能更高效。

Sub RangeTest()
  Dim MyChart As ChartObject

  Dim MyArray1(1 To 14) As Variant
  Dim MyArray2(1 To 14) As Variant
  Dim MyArray3(1 To 14) As Variant
  Dim MyArray4(1 To 14) As Variant
  Dim MyArray5(1 To 14) As Variant

  MyArray1(1) = 0
  MyArray1(2) = 0
  MyArray1(3) = 12.5
  MyArray1(4) = 25
  MyArray1(5) = 25
  MyArray1(6) = 50
  MyArray1(7) = 75
  MyArray1(8) = 75
  MyArray1(9) = 112.5
  MyArray1(10) = 150
  MyArray1(11) = 150
  MyArray1(12) = 200
  MyArray1(13) = 250
  MyArray1(14) = 250

  MyArray2(1) = 0
  MyArray2(2) = 100
  MyArray2(3) = 100
  MyArray2(4) = 100
  MyArray2(5) = 0
  MyArray2(6) = 0
  MyArray2(7) = 0
  MyArray2(8) = 0
  MyArray2(9) = 0
  MyArray2(10) = 0
  MyArray2(11) = 0
  MyArray2(12) = 0
  MyArray2(13) = 0
  MyArray2(14) = 0

  MyArray3(1) = 0
  MyArray3(2) = 0
  MyArray3(3) = 0
  MyArray3(4) = 0
  MyArray3(5) = 75
  MyArray3(6) = 75
  MyArray3(7) = 75
  MyArray3(8) = 0
  MyArray3(9) = 0
  MyArray3(10) = 0
  MyArray3(11) = 0
  MyArray3(12) = 0
  MyArray3(13) = 0
  MyArray3(14) = 0

  MyArray4(1) = 0
  MyArray4(2) = 0
  MyArray4(3) = 0
  MyArray4(4) = 0
  MyArray4(5) = 0
  MyArray4(6) = 0
  MyArray4(7) = 0
  MyArray4(8) = 50
  MyArray4(9) = 50
  MyArray4(10) = 50
  MyArray4(11) = 0
  MyArray4(12) = 0
  MyArray4(13) = 0
  MyArray4(14) = 0

  MyArray5(1) = 0
  MyArray5(2) = 0
  MyArray5(3) = 0
  MyArray5(4) = 0
  MyArray5(5) = 0
  MyArray5(6) = 0
  MyArray5(7) = 0
  MyArray5(8) = 0
  MyArray5(9) = 0
  MyArray5(10) = 0
  MyArray5(11) = 25
  MyArray5(12) = 25
  MyArray5(13) = 25
  MyArray5(14) = 0

  Set MyChart = ActiveSheet.ChartObjects.Add(Left:=10, Width:=900, Top:=265, Height:=245)
  With MyChart
    .Name = "Testing1"

    With .Chart
      With .SeriesCollection.NewSeries
        .XValues = MyArray1
        .Values = MyArray2
        .Name = "Alpha"
      End With
      With .SeriesCollection.NewSeries
        .XValues = MyArray1
        .Values = MyArray3
        .Name = "Beta"
      End With
      With .SeriesCollection.NewSeries
        .XValues = MyArray1
        .Values = MyArray4
        .Name = "Gamma"
      End With
      With .SeriesCollection.NewSeries
        .XValues = MyArray1
        .Values = MyArray5
        .Name = "Delta"
      End With

      .ChartType = xlAreaStacked
      With .Axes(xlCategory)
        .CategoryType = xlTimeScale
        .MajorUnitScale = xlDays
        .MajorUnit = 50
      End With
    End With
  End With
End Sub