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

使用VBA的Excel堆积面积图

1 个答案: