performance - Excel - VBA - 访问图表轴 - 速度问题

Question

我正在运行以下代码 400 次。我的工作表上有 60 个图表。执行时间为 300 秒。如果我删除这一行

 minVal = 0.02 * (cht.Chart.Axes(xlValue).MaximumScale - cht.Chart.Axes(xlValue).MinimumScale)

速度提高到 190 秒。鉴于 minVal 在之后(出于测试目的)被 0 覆盖，这条线没有任何影响。我希望了解为什么访问图表的轴如此耗时并且需要解决方法。

Sub quickAdjustLabels()
Dim cht As Excel.ChartObject
For Each cht In ActiveSheet.ChartObjects
    isProdChart = 0
    If cht.Chart.SeriesCollection(1).ChartType <> 5 Then 'different from pie
      minVal = 0.02 * (cht.Chart.Axes(xlValue).MaximumScale - cht.Chart.Axes(xlValue).MinimumScale)
      minVal = 0
      For Each myCollection In cht.Chart.SeriesCollection
          'if Stack and if not white visible (white visible are the bottom of waterfall charts / white unvisible are the NC stacks) => remove label is too small
          If (myCollection.ChartType = xlColumnStacked Or myCollection.ChartType = xlColumnStacked100) And (myCollection.Format.Fill.Visible = msoFalse Or myCollection.Format.Fill.ForeColor.RGB <> 16777215) Then
              myCollection.ApplyDataLabels
              vals = myCollection.Values
              For i = LBound(vals) To UBound(vals)
                  If Abs(vals(i)) < minVal Then myCollection.Points(i).HasDataLabel = False
              Next
          End If
          If myCollection.Name = Range("Client") Then isProdChart = 1 'Identify productivity charts
      Next myCollection
      'Remove labels on productivity charts
      If isProdChart = 1 Then
          For Each myCollection In cht.Chart.SeriesCollection
              If myCollection.ChartType = xlColumnStacked Then myCollection.DataLabels.Delete
          Next
      End If
    End If
Next cht
End Sub

Answer 1

您的问题不是您指出的语句，而是应用 DataLabels 的语句:

myCollection.ApplyDataLabels
myCollection.Points(i).HasDataLabel = False

设置 DataLabels 需要的时间越长，图表中的点越多。因此，尽量避免不必要地运行这些命令可能会为您节省一些时间。在设置值之前，请确认有必要更改它们

If Not myCollection.HasDataLabels Then
    myCollection.ApplyDataLabels
End If


For i = LBound(Vals) To UBound(Vals)
    shouldHaveLabel = True
    If Abs(Vals(i)) < MinVal Then
        shouldHaveLabel = False
    End If
    If myCollection.Points(i).HasDataLabel <> shouldHaveLabel Then
        myCollection.Points(i).HasDataLabel = shouldHaveLabel
    End If
Next

我希望这可以帮助你。

我通过在我的一个包含 56 个图表的 excel 文件上运行您的代码得出了这个结论。
我添加了一个时间度量，它会在执行结束时告诉我执行需要多长时间，然后一遍又一遍地运行它，注释掉不同的代码块，直到我能确定哪个 block 是需要很长时间的 block .

Dim tm As Date
tm = Now()    'get timestamp when execution started                            

    ...here goes the code to measure...

Debug.Print(Now()-tm)*24*60*60   'Show how many seconds execution took