创建一个没有数据源的多个excel图表的平均值

Question

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

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

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

编辑2：我修改了我的数据模板，以便匹配的时间序列数据范围不再是问题。同样按照对平均数的评论，数据的重量和数量都是相同的，所以这不应该是一个问题。它实际上只是归结为：是否有一种方法可以获取多个图表（或图表）的面值，并且在原始（或新）工作簿中没有大量数据操作的情况下，平均它们以形成新图表（或图表）？

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

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

Answer 1

我想创建一个新图表，它是多个复制图表的平均值。这在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 

Answer 2

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

从图表中提取数据，example code：

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作为第一站似乎取决于如何创建的图表。此示例中的代码适用于通过右键单击工作表中的某些数据并插入图表而创建的图表。

有关详细信息，请参阅MSDN上的Chart.SeriesCollection和Series Properties页面。

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