在没有数据源的情况下创建多个Excel图表的平均值

2 回答

• 2

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

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

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

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

  接下来，为了公开仪表板中的数据，我将从聚合的工作簿中复制丢失的图表，并重用已存在的图表 . 这样，如果所有图表都已存在，则仪表板的自定义将保持不变 .

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

  我汇编了一个工作示例，汇总了当前工作簿中的所有图表，并在“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
  

  回复于 2024-04-27T00:58:25+08:00
• 1

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

  要从图表中提取数据，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页面 .

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

  回复于 2024-04-27T00:58:25+08:00