问用VBA制作Excel堆积面积图
EN

Stack Overflow用户

提问于 2015-09-08 05:29:51

回答 1查看 1.4K关注 0票数 0

我正在尝试复制在以下站点中找到的结果：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

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

vba

excel

回答 1

Stack Overflow用户

发布于 2015-09-09 22:20:19

你没说哪里出了问题。

我并没有对你的代码做太多修改，只是重新排列了一下，让它更具可读性，也许也更有效率。

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

票数 0

页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持

原文链接：

https://stackoverflow.com/questions/32446271

复制

相似问题

问用VBA制作Excel堆积面积图
EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问用VBA制作Excel堆积面积图EN

回答 1

Stack Overflow用户

社区

活动

圈层

关于

腾讯云开发者

热门产品

热门推荐

更多推荐

问用VBA制作Excel堆积面积图
EN