Question

我使用图表来显示使用VBA的ms-access 2007上的活动进度，我曾经使用过PivotCharts，但速度很快但不能真正编辑。我只需要显示过去几个月，并在今年剩余时间内制作隐形点。

我的图表显示2系列300点（粒度增加），但我只在一个月内显示一次数据标签。我无法使用数据透视表逐点编辑，因此我转到了经典的oldStyle Chart。

我的问题是我的编辑非常慢，我已经阅读了很多关于VBA优化的内容，但没有做到这一点我为每条曲线测量了20秒，这对我的层次结构来说是“不可接受的”。我正在考虑多线程，但这对于如此小的好处（％4？或％8？）来说太过分了。

（FYI积分的计算等在表格开始之前完成并且表现很好）

这是我的慢图版的代码：

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 / when分割，如果您不关心仅使用整数，它也会很有帮助。试试吧。

Answer 2

也许你应该替换：

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

类似

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

并测量执行时间。关于你的代码的另一件事是：

oPnt.DataLabel.Font.Size = 14

...也许应该在if的内部试图避免重写属性两次。尝试类似：

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)

我希望它有所帮助。

通过访问VBA的Chart Edition非常慢

2 个答案: