Excel quits on Worksheet_Change Event

问题

Can someone please point out what's wrong with this snippet of code? Every time a value is changed in the specified range (A1:B6), Excel simply quits with Microsoft Error Reporting dialogue. I am not allowed to uncheck 'Error Checking (Turn on background error checking)' in Excel Preferences.

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

Macro1:

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

Second Macro

  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

回答1:

You'd better turn off events with Application.EnableEvents = False before doing so much calculation in Macro1.

If this works, just comment MsgBox "Before Macro1" and 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

Macro1:

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

来源：https://stackoverflow.com/questions/42248504/excel-quits-on-worksheet-change-event

标签

excel

vba

excel-vba

excel-formula