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 파일 중 하나에서 코드를 실행함으로써이 결론에 도달했습니다. 실행이 끝날 때 실행 시간을 알려주는 시간 측정 값을 추가하여 반복적으로 실행하여 여러 블록의 코드를 주석 처리하여 어느 블록이 오래 걸릴지 예측할 수있게했습니다 시각.

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