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文件上运行代码来得出这个结论。我添加了一个时间测量，告诉我在执行结束时需要多长时间执行，并一遍又一遍地运行它，注释掉不同的代码块，直到我能够确定哪个块需要很长时间。

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

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

1 个答案: