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