创build一个没有数据源的多个Excel图表的平均值

发人深省的问题（至less对我来说）。 通常，在创build图表时，您可以获取数据，然后使用它创build图表。 如果您然后将图表复制到另一个工作簿，图表上的值保持不变，但新工作簿中有“没有可用的”数据源。 我想创build一个新的图表，这是多个复制图表的平均值。 这在excel / vba中可能吗？

我什至不能尝试录制一个macros，并从那里，因为我不知道是否有可能“平均”多个图表。

编辑：一直在做一些更多的思考和思考，如果有可能，而不是提取数据到每个图表的新工作表，是否有可能提取平均数据。 如果在图表上右键单击 – >select数据 ，您可以在原始工作表中看到对数据的引用。 是否有可能平均，并打印结果，而不必存储所有的数据？ 如果可能的话，直接平均图表仍然会更容易！

编辑2：我已经改写了我的数据模板，以便匹配的时间序列数据范围不再是问题。 同样根据对平均数的评论，数据的重量和数量都是相同的，所以这不应该是一个问题。 它的字面意思是：有没有办法将多个图表（或图表）的面值取平均，形成一个新的图表（或图表），而无需在原始（或新的）工作簿中进行大量的数据操作？

赏金总结（包括圆形数字）：在VBA中寻找一个快速的方法来创build一个图表，这是多个图表的平均值。 我在50个单独的工作表上有10种types的图表。 我正在创build一个汇总表，其中有10个图表，用于平均来自另外50张图表上相同图表的数据。 关键的难点在于，这是一个所有图表都被复制到的“演示工作簿”，每个图表的所有数据都在不同的工作簿中。

编辑4：数据存储在多个时间序列表中，并列在主数据表中。 目前似乎（根据Scott的评论），没有办法直接操纵，最可能的解决scheme将是数据提取/操纵。 search仍然继续，虽然:)

Answer 1

我想创build一个新的图表，这是多个复制图表的平均值。 这在excel / vba中可能吗？

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

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

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

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

最后，我会直接在图表中插入汇总值，而不将它们存储在表单中。

我已经组装了一个工作示例，它汇总了当前工作簿中的所有图表，并将结果显示在“Dashboard”工作表中：

 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 

Answer 2

一些数据操作可能是必要的。 但是，您可以在内存中完成所有操作（如果您愿意，也可以在隐藏的工作表中）。

从图表中提取数据， 示例代码 ：

 Sub chartTest() Dim ch As ChartObject Set ch = Worksheets(1).ChartObjects(1) Dim nr As Variant, var As Variant, var 2 As Variant nr = UBound(ch.Chart.SeriesCollection(1).Values) ' Paste the values back onto the sheet Range(Cells(1, 1), Cells(nr, 1)) = Application.Transpose(ch.Chart.SeriesCollection(1).XValues) Range(Cells(1, 2), Cells(nr, 2)) = Application.Transpose(ch.Chart.SeriesCollection(1).Values) ' Pull the values into a variable (will be in array format) var = ch.Chart.SeriesCollection(1).XValues var2 = ch.Chart.SeriesCollection(1).Values ' Retrieval example For i = 1 To UBound(var) Range("A" & i).Value = var(i) Range("B" & i).Value = var2(i) Next i End Sub 

无论是使用Chart还是ChartObjects作为第一站，都取决于图表的创build方式。 此示例中的代码适用于通过右键单击工作表中的某些数据并插入图表而创build的图表。

有关更多信息，请参阅MSDN上的Chart.SeriesCollection和“ 系列属性”页面。

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