Select Case语句正在重新启用Application.ScreenUpdating

时间:2017-11-22 21:35:27

标签: excel vba

运行此子程序时,我不断重新启动Screen.Updating。将其缩小到此Select Case语句。代码工作它只是继续重新打开更新。

If count > 1 Then
Select Case count
    Case 2
        Range("N10") = arrSkills(1)
    Case 3
        Range("N10") = arrSkills(1)
        Range("N11") = arrSkills(2)
    Case 4
        Range("N10") = arrSkills(1) & " " & arrSkills(2)
        Range("N11") = arrSkills(3)
    Case 5
        Range("N10") = arrSkills(1) & " " & arrSkills(2)
        Range("N11") = arrSkills(3) & " " & arrSkills(4)
    Case Else
        MsgBox "Make room for more Skills"
End Select

Else

End If

这是Worksheet_Change事件

Private Sub Worksheet_Change(ByVal Target As Range)


If Target.Cells.count > 1 Or IsEmpty(Target) Then Exit Sub

If Not Intersect(Me.Range("Table[Name]"), Target) Is Nothing Then

Application.ScreenUpdating = False

'Code where the Select Case Statement is called

End If

Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:1)

正在发生的事情是,您对单元格N10和N11的更改会重新触发Worksheet_Change事件,并且该事件的最后一行正在设置Application.ScreenUpdating = True

通常最好在处理事件时禁用事件(除非你真的,真的需要因某种原因递归调用它)。使用

实现禁用事件
Application.EnableEvents = False

注意:要非常小心,你总是在完成时重新启用事件,否则你会花费数小时时间想知道为什么你的Change(等)事件不再被解雇。< / em>的

所以你的代码写得更好:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.count > 1 Or IsEmpty(Target) Then Exit Sub

    If Intersect(Me.Range("Table[Name]"), Target) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    'On Error statements are often more trouble than they are worth - but this is one
    '  occasion where it is dangerous not to use one.  You can't afford not to go
    '  through the statement re-enabling events.
    On Error GoTo ReEnableEvents
    Application.EnableEvents = False
    '...
    If count > 1 Then
        Select Case count
            Case 2
                Range("N10") = arrSkills(1)
            Case 3
                Range("N10") = arrSkills(1)
                Range("N11") = arrSkills(2)
            Case 4
                Range("N10") = arrSkills(1) & " " & arrSkills(2)
                Range("N11") = arrSkills(3)
            Case 5
                Range("N10") = arrSkills(1) & " " & arrSkills(2)
                Range("N11") = arrSkills(3) & " " & arrSkills(4)
            Case Else
                MsgBox "Make room for more Skills"
        End Select
    Else
        '...
    End If
    '...
    Application.ScreenUpdating = True
ReEnableEvents:
    Application.EnableEvents = True
End Sub