Question

我在Excel 2007的自定义功能区中使用VBA代码来插入＆＃34;帮助程序＆＃34;执行结束后要删除的工作表。

但是，在某些情况下，执行会在＆＃34; Worksheet.Add＆＃34;之后停止。调用函数时没有错误，没有调试文本，也没有弹出消息。我在每行代码后添加了自己的调试代码，并且在调用add函数后没有执行任何操作。

代码如下：

Private Function Difference(r1 As Range, r2 As Range) As Range
'Purpose: Returns a range containing only the cells which are not shared between the two passed ranges
Application.EnableEvents = False
On Error Resume Next
    Dim s As String
    Dim ws As Worksheet
    Dim diff As Range, zRng As Range, cRng As Range

    If Not r2 Is Nothing Then
    On Error GoTo Sheet_Cleanup
        If Not (r1.Parent Is r2.Parent) Then GoTo Exit_Code

        Set ws = Worksheets.Add
        For Each a In r1.Areas
            Set zRng = chkUnion(zRng, ws.Range(a.Address))
        Next a
        zRng = 0
        For Each b In r2.Areas
            Set cRng = chkUnion(cRng, ws.Range(b.Address))
        Next b
        cRng.Clear

        For Each c In ws.UsedRange.SpecialCells(xlCellTypeConstants).Areas
            Set diff = chkUnion(diff, r1.Parent.Range(c.Address))
        Next c
Sheet_Cleanup:
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
    On Error Resume Next
    Else
        Set diff = r1
    End If
    If Not diff Is Nothing Then Set Difference = diff
Exit_Code:
Application.EnableEvents = True
End Function

这不是一个理想的错误状态，因为它会留下工作表，必须由用户删除。

更奇怪的是，在没有产生这样的错误事件之后立即再次运行代码。

我已设法在特定工作表上重现错误，但它只发生在单击功能区按钮的第一个实例上，并且在Excel会话关闭并且工作表和功能区加载项重新打开之前不会再次发生

Answer 1

我可以在代码中看到一些逻辑缺陷。你应该删除＆＃34; On error resume next＆＃34;首先。我按如下方式重新组织了代码。您将收到一个包含错误的消息框。

Private Function Difference(r1 As Range, r2 As Range) As Range
'Purpose: Returns a range containing only the cells which are not shared 
between the two passed ranges
On Error got sub_error

Application.EnableEvents = False   
Dim s As String
Dim ws As Worksheet
Dim diff As Range, zRng As Range, cRng As Range

If Not r2 Is Nothing Then
    If Not (r1.Parent Is r2.Parent) Then GoTo sub_exit

    Set ws = Worksheets.Add
    For Each a In r1.Areas
        Set zRng = chkUnion(zRng, ws.Range(a.Address))
    Next a
    zRng = 0
    For Each b In r2.Areas
        Set cRng = chkUnion(cRng, ws.Range(b.Address))
    Next b
    cRng.Clear

    For Each c In ws.UsedRange.SpecialCells(xlCellTypeConstants).Areas
        Set diff = chkUnion(diff, r1.Parent.Range(c.Address))
    Next c   
Else
    Set diff = r1
End If
If Not diff Is Nothing Then Set Difference = diff

sub_exit:
Application.DisplayAlerts = False
if not ws is nothing then ws.Delete
Application.DisplayAlerts = True
exit function

sub_error:
msgbox (err.description)
resume sub_exit
End Function

添加工作表后执行停止

1 个答案: