Excel beendet Worksheet_Change-Ereignis

Question

Kann jemand bitte darauf hinweisen, was mit diesem Code-Schnipsel falsch ist? Jedes Mal, wenn ein Wert im angegebenen Bereich (A1: B6) geändert wird, wird Excel einfach mit dem Microsoft-Fehlerbericht beendet. Ich darf in den Excel-Einstellungen nicht die Option 'Fehlerprüfung (Hintergrund-Fehlerprüfung aktivieren)' deaktivieren.

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 

Makro1:

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 

zweite Makro

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

Sie würden besser Ereignisse mit Application.EnableEvents = False, bevor Sie so viel Berechnung in Macro1 auszuschalten.

Wenn dies funktioniert, Kommentar nur MsgBox "Before Macro1" und 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 

Makro1:

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