Performance 如何加快基于事件的过程?

Performance 如何加快基于事件的过程?,performance,vba,events,Performance,Vba,Events,我的事件过程有一个很大的问题,当我想一次更改多个单元格时,需要运行很长时间。工作原理,当用户更改单元格中的数据时,工作表\u Change会添加注释,但首先工作表\u SelectionChange会更新不同工作表中用户的信息,计算12个月的行动日期,然后通过camer工具在活动工作表上显示 在我看来,这个问题是因为事件不断循环。。。。不知道该怎么办 谢谢你的帮助 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range

我的事件过程有一个很大的问题,当我想一次更改多个单元格时,需要运行很长时间。工作原理,当用户更改单元格中的数据时,工作表\u Change会添加注释,但首先工作表\u SelectionChange会更新不同工作表中用户的信息,计算12个月的行动日期,然后通过camer工具在活动工作表上显示

在我看来,这个问题是因为事件不断循环。。。。不知道该怎么办

谢谢你的帮助

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

您可以考虑将集合范围指定为数组,然后循环,因为数组快得多。