Excel退出Worksheet_Change事件

Question

有人可以指出这段代码有什么问题吗？每当指定范围（A1：B6）中的值发生更改时，Excel都会退出Microsoft Error Reporting对话框。 我不能在Excel首选项中取消选中'错误检查（打开背景错误检查）'。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Set KeyCells = Range("A1:B6") 

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then 
     Call Macro1 
     MsgBox "Test" 
    End If 
End Sub 

宏1：

Sub Macro1() 

    Dim wb As Workbook 
    Dim wsData As Worksheet 
    Dim wsDest As Worksheet 
    Dim rInterestCell As Range 
    Dim rDest As Range 

    Set wb = ActiveWorkbook 
    Set wsData = wb.Sheets("Sheet1") 
    Set wsDest = wb.Sheets("Formula Results") 

    For Each rInterestCell In Range("Interest_Range").Cells 
     wsData.Range("A7").Value = rInterestCell.Value 
     wsData.Calculate  
     Set rDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1) 
     If rDest.Row < 6 Then Set rDest = wsDest.Range("A6") 
     rDest.Value = wsData.Range("A6").Value 
    Next rInterestCell 

End Sub 

第二个宏

Sub Macro2() 
Dim FLrange As Range 
Set FLrange = Range(“Initial_Rate”) 

For Each cell In FLrange 
cell.Offset(0, 5).Formula = "=SUM(B3/100*A7)” 

Next cell 
End Sub 

Answer 1

你最好在Macro1做了许多计算之前关闭事件与Application.EnableEvents = False。

如果一切正常，只是发表评论MsgBox "Before Macro1"和MsgBox "After Macro1"

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim KeyCells As Range 
    Set KeyCells = Me.Range("A1:B6") 

    If Not Application.Intersect(KeyCells, Target) Is Nothing Then 
     MsgBox "Before Macro1" 
     Macro1 
     MsgBox "After Macro1" 
    End If 
End Sub 

宏1：

Sub Macro1() 
    Dim wB As Workbook 
    Dim wsData As Worksheet 
    Dim wsDest As Worksheet 
    Dim rInterestCell As Range 
    Dim rDest As Range 

    Set wB = ActiveWorkbook 
    Set wsData = wB.Sheets("Sheet1") 
    Set wsDest = wB.Sheets("Formula Results") 

    Application.EnableEvents = False 

    For Each rInterestCell In Range("Interest_Range").Cells 
     wsData.Range("A7").Value = rInterestCell.Value 
     wsData.Calculate 
     DoEvents 
     Set rDest = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1) 
     If rDest.Row < 6 Then Set rDest = wsDest.Range("A6") 
     rDest.Value = wsData.Range("A6").Value 
    Next rInterestCell 

    Application.EnableEvents = True 
End Sub