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