Question

有人可以指出这段代码有什么问题吗？每次在指定范围内更改值（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

宏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

在Application.EnableEvents = False进行大量计算之前，您最好使用Macro1关闭事件。

如果有效，请发表评论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

Excel退出Worksheet_Change事件

1 个答案: