Excel – VBA – 访问图表轴 – 速度问题

我正在运行下面的代码400次。 我有60张图表。 执行时间是300秒。 如果我删除这一行

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

速度提高到190秒。 这条线不会影响任何给定的minVal被0覆盖（就testing目的而言）。 我期待着明白为什么访问图表的轴是如此费时，以及解决方法。

 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需要的时间越长，图表中的点越多。 所以试图避免不必要的运行这些命令可能会为您节省一些时间。 在设置值之前，请validation是否有必要更改它们

 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个graphics的excel文件之一上运行代码来得出这个结论。 我添加了一个时间度量，它会在执行结束时告诉我执行需要多长时间，然后反复运行，注释掉不同的代码块，直到找出哪个块需要很长时间。

 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