Chart Edition by VBA very Slow

Question

Я использую диаграмму для отображения прогресса активности в ms-access 2007 с VBA, я работал с PivotCharts, который был быстрым, но не очень редактируемым. Мне нужно показывать только последние месяцы и делать невидимые очки в течение оставшейся части года.

My Chart - это дисплей с 2-мя сериями из 300 точек (увеличилась гранулярность), но я показываю только метки данных один раз в месяц. Я не смог отредактировать точку за точкой с помощью сводной диаграммы, поэтому перешел к классической схеме OldStyle.

Моя проблема в том, что мое редактирование происходит очень медленно, я читал о многом о оптимизации VBA, но ничего не сделал трюк Я измерил 20 секунд для каждой кривой, это не «приемлемо» для моей иерархии. Я думал о многопоточности, но это слишком большая работа для такого небольшого преимущества (% 4? Или% 8?)

(FYI Расчет точек и т. Д. Производится до открытия формы и делает большой)

Вот мой код этого Slow Chart издание:

Dim intPntCount As Integer 
Dim intTmp As Integer 
Dim oSeries As Object 
Dim colSeries As SeriesCollection 
Dim oPnt As Object 
Dim intCptSeries As Byte 
Dim booPreviousZero As Boolean 
Dim startDate, endDate As Date 
Dim lngWhite, LngBlack As Long 

lngWhite = RGB(255, 255, 255) 
LngBlack = RGB(0, 0, 0) 
linPlanned.BorderColor = RGB(251, 140, 60) 
linCompleted.BorderColor = RGB(52, 84, 136) 

lblUnit.Left = 1248 'use fctgetabsciisa chProgressFixs.Axes(2).MaximumScale/80 

With Me.chProgressFixs 
    startDate = Now 
    .BackColor = lngWhite 
    intCptSeries = 0 
    'colSeries = .SeriesCollection 
    For Each oSeries In .SeriesCollection 
     intCptSeries = intCptSeries + 1 
     Debug.Print "Series" & intCptSeries 
     booPreviousZero = True 
     intPntCount = 1 
     For Each oPnt In oSeries.Points 
      oPnt.ApplyDataLabels 
      If oPnt.DataLabel.Caption = "0" Then 
       oPnt.Border.Weight = 1 
       oPnt.DataLabel.Caption = vbNullString 
       If booPreviousZero = False Then 
        oPnt.Border.Color = lngWhite 
        booPreviousZero = True 
       Else 
        oPnt.Border.Color = LngBlack 
       End If 
      Else 
       booPreviousZero = False 
       oPnt.Border.Weight = 4 
       oPnt.DataLabel.Font.Size = 14 
       Select Case intCptSeries 
        Case 1: oPnt.Border.Color = linPlanned.BorderColor 
        Case 2: oPnt.Border.Color = linCompleted.BorderColor 
       End Select 

       If ((intPntCount + 30)/30 <> Int((intPntCount + 30)/30)) Then 
        If (intPntCount < oSeries.Points.Count) Then 
         If (intPntCount <> IntLastDispDay - 1) Then 
          oPnt.DataLabel.Caption = vbNullString 
         Else 
          oPnt.DataLabel.Font.Size = 20 
         End If 
        End If 
       End If 
      End If 
      intPntCount = intPntCount + 1 
     Next 
     Debug.Print DateDiff("s", startDate, Now) 
    Next 
    Me.TimerInterval = 1 
End With 

Спасибо всем за вашу помощь

Answer 1

Возможно, вам нужно, чтобы избежать обновления экрана с:

Application.ScreenUpdating = False 

, а затем

Application.ScreenUpdating = true 

, когда закончите. Также полезно, если вы используете \ insted of/при делении, если вы не заботитесь о работе только с целыми числами. Попробуй.

Answer 2

Может быть, вы должны заменить:

If ((intPntCount + 30)/30 <> Int((intPntCount + 30)/30)) Then 

с чем-то вроде

If (((intPntCount + 30) MOD 30) > 0) Then 

и измерить время выполнения. Еще одна вещь, о вашем коде является то, что:

oPnt.DataLabel.Font.Size = 14 

... возможно должно быть внутри, если пытается избежать переписать свойству два раза. Попробуйте что-то вроде:

If (((intPntCount + 30) MOD 30) > 0) Then 
    If (intPntCount < oSeries.Points.Count) Then 
      If (intPntCount <> IntLastDispDay - 1) Then 
       oPnt.DataLabel.Caption = vbNullString 
       oPnt.DataLabel.Font.Size = 14 
      Else 
       oPnt.DataLabel.Font.Size = 20 
      End If 
Else 
    oPnt.DataLabel.Font.Size = 14 
    End If 
Else 
oPnt.DataLabel.Font.Size = 14 
End If 

Даже это было бы очень и очень небольшое улучшение предвычислять

(intPntCount + 30) 

в переменной после

intPntCount = intPntCount + 1 

...и использовать что-то вроде:

dim intPntCountSum= 0 
(...) 
    End If 
    intPntCount = intPntCount + 1 
    intPntCountSum=intPntCount + 30 
Next 

Наконец, если вам не нужны данные отладки, это будет хорошая вещь, чтобы удалить строки:

Debug.Print "Series" & intCptSeries 

и

Debug.Print DateDiff("s", startDate, Now) 

Надеюсь, это поможет.