我如何加快我的基于事件的程序?

时间:2014-09-24 08:43:29

标签: performance vba events

我的事件程序存在很大问题,当我想要同时更改多个单元格时,运行需要很长时间。它是如何工作的,当用户在单元格中更改数据时,Worksheet_Change会添加注释,但首先是Worksheet_SelectionChange更新用户的信息(我在不同的工作表中有sumifs,它计算12个月的ACT日期,然后通过活动工作表上的camer工具显示)。

知道问题是不断循环事件...... duno该做什么?!

求助!

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range

ActiveSheet.Unprotect Password:="xyz"

For Each cell In Target

        If cell.Row > 21 And cell.Column > 9 Then

            If cell.Comment Is Nothing Then
                cell.AddComment Now & " - " & cell.Value & " - " & Application.UserName
            Else
                If Val(Len(cell.Comment.Text)) > 255 Then
                    cell.Comment.Delete
                    cell.AddComment
                    cell.Comment.Text _
                    Now & " - " & cell.Value & " - " & Application.UserName, 1 _
                    , False
                Else
                    cell.Comment.Text _
                    vbNewLine & Now & " - " & cell.Value & " - " & Application.UserName, Len(cell.Comment.Text) + 1 _
                    , False
                End If
            End If

        cell.Comment.Shape.TextFrame.AutoSize = True

        End If

Next cell

ActiveSheet.Protect Password:="11opkLnm890", AllowFiltering:=True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim RowNumber As Long, i As Long
Dim MaxRowNumber As Long

MaxRowNumber = Range("A9").Value

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

RowNumber = Target.Row

Set sh_AUXILIARY_PT = ThisWorkbook.Worksheets("AUXILIARY_PT")

    If Target.Row > 21 And Target.Row < MaxRowNumber Then

        sh_AUXILIARY_PT.Range("AA4").Value = Cells(RowNumber, 1).Value
        sh_AUXILIARY_PT.Range("AB4").Value = Cells(RowNumber, 2).Value
        sh_AUXILIARY_PT.Range("AC4").Value = Cells(RowNumber, 3).Value
        sh_AUXILIARY_PT.Range("AD4").Value = Cells(RowNumber, 4).Value

        For i = 14 To 25

        sh_AUXILIARY_PT.Cells(8, i).Value = Cells(RowNumber, i - 4).Value

        Next i

    End If

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

1 个答案:

答案 0 :(得分:0)

好吧,你可以考虑将你的收藏范围分配给一个数组然后循环,因为数组的速度要快得多。