Excel VBA 填充系列采集太慢了！当 RunTime 填充了很多 SeriesCollections 时如何提高图表性能

Question

任务：使用速度测试并使其运行得比现在更快。

信息： 我的电脑速度很快。我有一个柱形图。 图表的整个值以及表格的值都是在 VBA 中计算的，并且表格本身由于其设计原因无法加载到图表中。所以我们需要用VBA获取其中的值。 4 年期间的每个月在图表中都乘以 2 表示，因为有两种不同的模式。为每个显示的数据组成 8 个系列。 （这也是不可避免的） 大约有 25 种不同的数据以这种方式显示，并由用户使用按钮使用图表的 Is.Filtered 功能以智能方式进行过滤，以实现良好的显示。 [图表] (https://i.sstatic.net/XWxYAWBc.png)

问题：图表添加所有数据的速度太慢（仅在创建时执行一次，仅在数据更改时发生）。

问题1：有没有办法在添加新系列时禁止图表一直重新加载？

问题2：是否可以预先定义SeriesCollection，然后添加一次，导致图表也只刷新一次？

我尝试过什么：

• Application.EnableEvents = False

  ，ScreenUpdate 等根本不会加快进程
• 我尝试创建一个新的SeriesCollection，或者从现有图表中复制一个并将其粘贴到另一个图表中，但我想你做不到

  Chart1.SeriesCollection =  Chart2.SeriesCollection

  。说不支持。
• 使用

  set

  作为新变量可以使其连接到图表并保持重新加载
• 我尝试创建新系列以立即过滤它。这只需要更长的时间

这是一个调试功能，可将系列添加到图表中以进行速度测试。我的结果是大约 650 毫秒，太长了！重点关注顶部的代码块，下面的两个代码块只是用于速度测试的函数，您可能需要这些函数来进行测试：

Sub TestDiagramPerformance()

    With Tabelle2.ChartObjects("TestDiagram").Chart

        'Delete ALL Data (For Retesting)
        For Each s In .FullSeriesCollection: s.Delete: Next s

    Call DebugTimer(True, "Test") 'Start Timer

        'Add Series
        For fi = 1 To 250:
         .SeriesCollection.NewSeries
         .SeriesCollection(fi).XValues = 500 'THIS TAKES TOO LONG!
         .SeriesCollection(fi).Values = 10 'THIS TAKES TOO LONG!
        Next
            
    End With
    
    Call DebugTimer(False, "Test") 'Finish Timer and display Time
    
End Sub

'This is the DebugTimer (works Fine, just for testing)
'Public Sub DebugTimer(StartOrEnd As Boolean, Optional AdditionalName = 1, Optional Priority = 1)
'If ReadName("DebugSettings_IsTimerEnabled") = False Then Exit Sub
'If ReadName("DebugSettings_EnabledTimerPriorities") < Priority Then Exit Sub
' Name = "DebugTimer_" & AdditionalName
'    Select Case StartOrEnd
'    Case True
'            Application.Names.Add _
'            Name:=Name, _
'            RefersTo:=Timer 'No Procces Time Since is Last Line
'    Case False
'        nv = Application.Names(Name).Value
'        n = Split(Mid(nv, 2, Len(nv) - 1), ".")
'        If (UBound(n) > 0) Then
'         XN = n(0) & "," & n(1)
'         Debug.Print Name, Format(((Timer - XN)) * 1000, "#####.## ms")
'        Else
'         Debug.Print "An Error Occured in the DebugTimer"
'        End If
'        Application.Names(Name).Delete 'Process Time consuming circa 4 seconds on my device
'    End Select
'End Sub

'ReadName Funciton (works fine, Used in DebugTimer)
'Public Function ReadName(Name)
'v = Application.Names(Name).Value
'        If Left(v, 2) = "=" & chr$(34) Then  'Wenn Normal (Text) "="text"" oder "="416,67""
'    OutPut = Mid(v, 3, Len(v) - 3) 'Read TextFormat
'         If OutPut = str(True) Or OutPut = str(False) Then ReadName = CBool(OutPut): Exit Function  'Wenn Bool Return Convert to Bool
'        Else 'Wenn Number Format "=100"
'    OutPut = Mid(v, 2, Len(v) - 1) 'ReadNumber
'        End If
'    If IsNumeric(OutPut) And InStr(1, OutPut, ".") Then OutPut = Replace(OutPut, ".", ",") 'Regain Comma
'    If IsNumeric(OutPut) Then OutPut = CDbl(OutPut) 'Convert to Double on Numeric
'ReadName = OutPut
'End Function

Answer 1

不完全是您的设计，但速度要快得多。只是为了确保我理解您想要我们进行的测试，请将此视为第一次尝试。在这种情况下，数据是从工作表中读取的，您只是说您需要从 vba 本身完成它，但我们可以稍后修复此问题。我的电脑没有你的快，但我在 10 毫秒内完成了这一任务：

Sub QuickFill()

Dim dStart  As Double
Dim dEnd    As Double

    dStart = Timer
    
    With Tabelle2.ChartObjects("Diagramm").Chart
        .SeriesCollection.NewSeries
        .FullSeriesCollection(1).Values = "=Tabelle2!$A$1:$A$250"
        .FullSeriesCollection(1).XValues = "=Tabelle2!$B$1:$B$250"
    End With

    dEnd = Timer
    Debug.Print dEnd - dStart
    
End Sub

数据在表中，如下所示：