Excel退出Worksheet_Change事件

问题描述

有人可以指出这段代码有什么问题吗？每次在指定范围（A1：B6）中更改值时，Excel将退出Microsoft错误报告对话框。我不允许在Excel首选项中取消选中错误检查（打开背景错误检查）。

  Private Sub Worksheet_Change（ByVal Target As Range）
 Dim KeyCells As Range 
设置KeyCells = Range（A1：B6）
 
如果不是Application.Intersect（KeyCells， Range（Target.Address））Not Not Then然后
调用Macro1 
 MsgBoxTest
 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 
设置wsData = wb.Sheets（Sheet1）
设置wsDest = wb.Sheets（Formula Results）
 
对于每个rInterestCell In Range（Interest_Range） .Cells 
 wsData.Range（A7）。Value = rInterestCell.Value 
 wsData.Calculate 
设置rDest = wsDest.Cells（wsDest.Rows.Count，A）。End（xlUp）.Offset（1）
如果rDest.Row< 6然后设置rDest = wsDest.Range（A6）
 rDest.Value = wsData.Range（A6）。值
下一个rInterestCell 
 
 End Sub 
  

第二个宏

  Sub Macro2（）
 Dim FLrange As Range 
设置FLrange = Range（Initial_Rate）
 
对于每个单元格在FLrange 
 cell.Offset（0， 5）.Formula == SUM（B3 / 100 * A7）
 
下一个单元格
 End Sub 
  

解决方案

在这样做之前，最好关闭 Application.EnableEvents = False 在 Macro1 中计算很多。

如果这样工作，只需注释 MsgBoxBefore Macro1 和 MsgBoxAfter Macro1

  Private Sub Worksheet_Change（ByVal Target As Range）
 Dim KeyCells As Range 
设置KeyCells = Me.Range（A1：B6）
 
如果不是Application.Intersect（KeyCells，目标）没有，然后
消息Box之前Macro1
宏1 
 MsgBox之后Macro1
结束如果
结束Sub 
  

Macro1：

  Sub Macro1（）
 Dim wB As Workbook 
 Dim wsData As Worksheet 
 Dim wsDest As Worksheet 
 Dim rInterestCell As Range 
 Dim rDest As Range 
 
设置wB = ActiveWorkbook 
设置wsData = wB .Sheets（Sheet1）
设置wsDest = wB.Sheets（公式结果）
 
 Application.EnableEvents = False 
 
对于每个rInterestCell In Range Interest_Range）。单元格
 wsData.Range（A7）。Value = rInterestCell.Value 
 wsData.Calculate 
 DoEvents 
设置rDest = wsDest.Cells（wsDest.Rows .Count，A）。End（xlUp）.Offset（1）
如果rDest.Row< 6然后设置rDest = wsDest.Range（A6）
 rDest.Value = wsData.Range（A6）。值
下一个rInterestCell 
 
 Application.EnableEvents = True 
 End Sub 
  

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

解决方案

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

这篇关于Excel退出Worksheet_Change事件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！