主页 / computer / 问题 / 1505143
Accepted
Ghenadie
Asked: 2019-11-27 00:35:37 +0800 CST

使用 Excel xy 散点图作为一条线的余额调度

  • 772

是否可以在一个 XY（散点图）图表中自动添加更多系列？也许通过一些VBA？问题是对于每个 x 和 y 我都有两个值。该示例在下面的屏幕截图中。

在此处输入图像描述

当您有 500 个系列时，将几个系列添加到一个图表棒上是没有问题的 - 这是一个大问题。请让我知道是否有任何方法可以做到这一点。

microsoft-excel charts

1 个回答

  1. Best Answer

    请记住，每个图表有 255 个系列的限制。如果你能保持在这个范围内，这些程序将有所帮助。

    要使用表中的数据创建新图表：

    Sub InsertNewChart()
  Dim ws As Worksheet
  Set ws = ActiveSheet
  Dim cht As Chart
  Set cht = ws.Shapes.AddChart2(XlChartType:=xlXYScatterLinesNoMarkers).Chart
  cht.ChartArea.ClearContents
  Dim iRow As Long
  For iRow = 2 To ws.Range("A1").CurrentRegion.Rows.Count
    With cht.SeriesCollection.NewSeries
      .Name = "=" & ws.Cells(iRow, 2).Address(, , , True)
      .Values = ws.Cells(iRow, 4).Resize(, 2)
      .XValues = ws.Cells(iRow, 6).Resize(, 2)
    End With
  Next
End Sub

    要将现有图表扩展一个系列，请使用图表中最后一个系列之后的行中的数据：

    Sub ExtendChart()
  Dim cht As Chart
  Set cht = ActiveChart
  Dim sFmla As String
  sFmla = cht.SeriesCollection(cht.SeriesCollection.Count).Formula
  sFmla = Mid$(Left$(sFmla, Len(sFmla) - 1), InStr(sFmla, "(") + 1)
  Dim vFmla As Variant
  vFmla = Split(sFmla, ",")
  Dim rName As Range
  Set rName = Range(vFmla(LBound(vFmla)))
  Dim rXVals As Range
  Set rXVals = Range(vFmla(LBound(vFmla) + 1))
  Dim rYVals As Range
  Set rYVals = Range(vFmla(LBound(vFmla) + 2))
  With cht.SeriesCollection.NewSeries
    .Name = "=" & rName.Offset(1).Address(, , , True)
    .XValues = rXVals.Offset(1)
    .Values = rYVals.Offset(1)
  End With
End Sub

    要像上面那样扩展图表，但每行添加一个系列，直到数据用完：

    Sub KeepExtendingChart()
  Dim cht As Chart
  Set cht = ActiveChart
  Do
    Dim sFmla As String
    sFmla = cht.SeriesCollection(cht.SeriesCollection.Count).Formula
    sFmla = Mid$(Left$(sFmla, Len(sFmla) - 1), InStr(sFmla, "(") + 1)
    Dim vFmla As Variant
    vFmla = Split(sFmla, ",")
    Dim rName As Range
    Set rName = Range(vFmla(LBound(vFmla)))
    If Len(rName.Offset(1).Value) = 0 Then Exit Do
    Dim rXVals As Range
    Set rXVals = Range(vFmla(LBound(vFmla) + 1))
    Dim rYVals As Range
    Set rYVals = Range(vFmla(LBound(vFmla) + 2))
    With cht.SeriesCollection.NewSeries
      .Name = "=" & rName.Offset(1).Address(, , , True)
      .XValues = rXVals.Offset(1)
      .Values = rYVals.Offset(1)
    End With
  Loop
End Sub
    • 1

相关问题