vba - 在没有数据源的情况下创建多个excel图表的平均值

Question

发人深省的问题(至少对我而言)。通常在创建图表时，您拥有数据，然后使用它来创建图表。如果您随后将图表复制到另一个工作簿，图表上的值将保持不变，但新工作簿中没有“可用”数据源。我想创建一个新图表，它是多个复制图表的平均值。这在 excel/vba 中可行吗？

我什至无法尝试录制宏并从那里开始，因为我不知道是否可以“平均”多个图表。

编辑:一直在做更多的思考，并且正在考虑是否可以代替将数据提取到每个图表的新工作表中，是否可以在提取时对数据进行平均。如果你在图表上 右击->选择数据 ，您可以看到对原始工作表中数据的引用。是否可以对此进行平均并仅打印结果而无需存储所有数据？如果可能的话，直接平均图表仍然会更容易!

编辑 2:我重新设计了我的数据模板，以便匹配时间序列数据范围不再是问题。此外，根据对平均值的评论，数据的重量和数量都相同，所以这应该不是问题。它实际上只是归结为:有没有一种方法可以获取多个图表(或图形)的面值，并将它们平均以形成一个新的图表(或图形)，而无需在原始(或新)工作簿中进行大量数据操作？

赏金摘要(带有整数):在 VBA 中寻找一种快速的方式来创建一个图表，该图表是多个图表的平均值。我在 50 个单独的工作表上有 10 种类型的图表。我正在寻找一个包含 10 个图表的汇总表，这些图表平均来自其他 50 个工作表上相同图表的数据。关键难点在于这是一个所有图表都复制到其中的“演示工作簿”，每个图表的所有数据都在不同的工作簿中。

编辑 4:数据存储在多个时间序列表中，这些表在主数据表中并排排列。目前(根据​​ Scott 的评论)似乎没有办法直接操作，最有可能的解决方案是数据提取/操作。搜索仍在继续:)

Answer 1

I want to create a new chart which is the average of multiple copied charts. Is this possible in excel/vba?

这是可能的，但这个任务没有神奇的公式。

我将首先迭代每个工作簿、每个工作表、每个形状并将值聚合到一个数组中，每种类型的图表都有一个数组。
为了避免存储所有数据，必须在每次提取时计算平均值，如下所示:

Average = ((PreviousAverage * N) + Value) / (N + 1)

接下来，为了在您的仪表板中公开数据，我将从聚合工作簿中复制缺失的图表并重新使用已经存在的图表。
这样，如果所有图表都已经存在，仪表板的自定义将保持不变。

最后，我会直接在图表中插入聚合值，而不将它们存储在工作表中。

我已经组装了一个工作示例，该示例汇总了当前工作簿中的所有图表并在工作表“仪表板”中显示结果:

Sub AgregateCharts()

  Dim ws As Worksheet, wsDashboard As Worksheet, sh As Shape, ch As chart
  Dim xValues(), yValues(), yAverages(), weight&, key
  Dim items As Scripting.dictionary, item As Scripting.dictionary
  Set items = CreateObject("Scripting.Dictionary")

  ' define the dashboard sheet
  Set wsDashboard = ThisWorkbook.sheets("Dashboard")

  ' disable events
  Application.ScreenUpdating = False
  Application.EnableEvents = False

  ' iterate worksheets  '
  For Each ws In ThisWorkbook.Worksheets
    ' if not dashboard  '
    If Not ws Is wsDashboard Then
      ' iterate shapes      '
      For Each sh In ws.Shapes
        If sh.type = msoChart Then ' if type is chart    '

          Debug.Print "Agregate " & ws.name & "!" & sh.name

          ' check if that type of chart was previously handled
          If Not items.Exists(sh.chart.chartType) Then

            ' extract the values from the first serie
            xValues = sh.chart.SeriesCollection(1).xValues
            yValues = sh.chart.SeriesCollection(1).values

            ' duplicate the chart if it doesn't exists in the dashboard
            Set ch = FindChart(wsDashboard, sh.chart.chartType)
            If ch Is Nothing Then
              Set ch = DuplicateChart(sh.chart, wsDashboard)
            End If

            ' store the data in a new item   '
            Set item = New Scripting.dictionary
            item.Add "Chart", ch
            item.Add "Weight", 1   ' number of charts used to compute the averages
            item.Add "XValues", xValues
            item.Add "YAverages", yValues
            items.Add ch.chartType, item  ' add the item to the collection  '

          Else

            ' retreive the item for the type of chart  '
            Set item = items(sh.chart.chartType)
            weight = item("Weight")
            yAverages = item("YAverages")

            ' update the averages : ((previous * count) + value) / (count + 1)  '
            yValues = sh.chart.SeriesCollection(1).values
            UpdateAverages yAverages, weight, yValues

            ' save the results  '
            item("YAverages") = yAverages
            item("Weight") = weight + 1

          End If

        End If
      Next
    End If
  Next

  ' Fill the data for each chart in the dashboard
  For Each key In items
    Set item = items(key)
    Set ch = item("Chart")

    ' Add the computed averages to the chart
    ch.SeriesCollection(1).xValues = "={" & Join(item("XValues"), ";") & "}"
    ch.SeriesCollection(1).values = "={" & Join(item("YAverages"), ";") & "}"
  Next

  ' restore events
  Application.EnableEvents = True
  Application.ScreenUpdating = True

End Sub

Private Sub UpdateAverages(averages(), weight&, values())
  Dim i&
  For i = LBound(averages) To UBound(averages)
    averages(i) = (averages(i) * weight + values(i)) / (weight + 1)
  Next
End Sub

Private Function DuplicateChart(ByVal source As chart, target As Worksheet) As chart

  ' clone the chart to the target
  source.Parent.Copy
  target.Paste
  Application.CutCopyMode = 0

  ' clear the data '
  With target.Shapes(target.Shapes.count).chart.SeriesCollection(1)
    Set DuplicateChart = .Parent.Parent
    .name = CStr(.name)
    .xValues = "={0}"
    .values = "={0}"
  End With

End Function

Private Function FindChart(source As Worksheet, chartType As XlChartType) As chart

  ' iterate each shape in the worksheet to fin the corresponding type
  Dim sh As Shape
  For Each sh In source.Shapes
    If sh.type = msoChart Then
      If sh.chart.chartType = chartType Then
        Set FindChart = sh.chart
        Exit Function
      End If
    End If
  Next

End Function