Excel退出Worksheet_Change事件

有人可以指出这段代码有什么问题吗？ 每当指定范围（A1：B6）中的值发生更改时，Excel都会退出Microsoft错误报告对话框。 我不允许在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 

macros1：

 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 

第二个macros

  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 = Falseclosures事件。

如果这个工作，只是评论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 

macros1：

 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