創建一個沒有數據源的多個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頁面。

所以基本上，使用類似於上面的代碼從圖表中提取所有數據，比較它們，並根據這些數據創建一個新圖表。