Vba 在不使用数据源的情况下创建多个excel图表的平均值

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

我甚至不能尝试录制一个宏并从那里开始，因为我不知道是否可能“平均”多个图表

编辑：我一直在思考，如果可以不将数据提取到每个图表的新工作表中，是否可以在提取时平均数据。如果在图表上单击鼠标右键->选择数据，则可以在原始工作表中看到对数据的引用。是否有可能在不必存储所有数据的情况下对结果进行平均并仅打印结果？如果可能的话，直接平均图表会更容易

编辑2:我已重新修改了数据模板，以便匹配时间序列数据范围不再是问题。此外，根据对平均数平均值的评论，数据的权重和数量都是相等的，因此这应该不是一个问题。从字面上讲，它可以归结为：有没有一种方法可以将多个图表（或图形）的面值取平均值，从而形成一个新的图表（或图形），而无需在原始（或新）工作簿中进行大量数据操作

赏金摘要（带整数）：在VBA中寻找一种快速的方法来创建多个图表的平均值。我在50张单独的工作表上有10种图表。我希望创建一个汇总表，其中包含10个图表，这些图表平均了其他50张表中相同图表的数据。关键的困难在于，这是一个“演示工作簿”，所有图表都复制到其中，每个图表的所有数据都在不同的工作簿中

---

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

可能需要一些数据操作。但是，您可以在内存中（或者在隐藏的工作表中，如果您愿意的话）完成这一切

要从图表中提取数据，请执行以下操作：

使用

图表

还是

图表对象

作为第一站似乎取决于图表的创建方式。本例中的代码适用于通过右键单击工作表中的某些数据并插入图表创建的图表

有关更多信息，请参阅和MSDN上的页面

因此，基本上，使用与上面类似的代码从图表中提取所有数据，比较它们，并基于这些数据创建一个新图表

我想创建一个新图表，它是多个复制图表的平均值。这在excel/vba中是否可行

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

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

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

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

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

我收集了一个工作示例，该示例汇总了当前工作簿中的所有图表，并将结果显示在工作表“Dashboard”中：

---

也许可以尝试将每个图表的数据点值提取到一个范围内，在另一个范围内创建平均值，然后根据该数据创建图表？感谢您的建议，这是一个好主意！我会做一些研究，看看我从哪里得到：）是的，你唯一无法访问数据的方法是将图表复制为图片。即使数据来自另一个工作簿，公式也应该存在于数据源中，或者至少序列中的值会存在，您可以使用VBA访问。嗯，我做了一些研究，找到了从图表中提取数据并放入新表的方法，这将是一个伟大的图表，但我与约25个工作表与5种类型的图表每个工作。有没有办法直接“平均”多个图表？i、 e跳过中间人，以与平均数据相同的方式对图表进行平均？除了这些技术难题外，您是否还面临平均值问题？感谢您的帮助，如果没有直接的方法，可能最终不得不采用数据提取路线。在一份新的editSure中解决了这个问题并发表了一些评论。使用此方法的唯一“痛苦”应该是让代码适用于所有不同的图表类型。一旦启动并运行，它应该在不到一秒钟内得到您的结果（至少只要您在内存中工作）。没错，隐藏工作表可以处理演示方面的问题！将试一试，看看它会走向何方：）

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