On Error Goto Msg无法正常工作

时间:2018-01-31 02:51:36

标签: excel vba excel-vba

大家好日子!

我正在编写一个代码转换一些数据。我目前的代码问题是,即使没有错误,“ErrMsg”也会弹出。如果我在“On Error GoTo ErrMsg”之后输入“Exit Sub”,则整个模块无法继续,我也无法调用下一个模块。希望有人可以帮助我!

我下面的代码运行正常但它显示了MsgBox,即使没有错误。

Sub Five_Transpose()

Dim LPID As Range
Dim InvestorName As Range
Dim DataTableX As ListObject
Dim Rng As Range
Dim rngB As Range

    With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    End With

    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Funds Table"

    Sheets("Filtered Data").Copy After:=ActiveSheet
    ActiveSheet.Name = "X"

    On Error GoTo ErrMsg

    With Sheets("X")
    Set DataTableX = ActiveSheet.ListObjects(1)
    DataTableX.Name = "DataTableX"
    .Range("DataTableX[#All]").RemoveDuplicates Columns:=2, Header:=xlYes
    .Range(Range("A1"), Range("A1").End(xlDown)).Copy Destination:=Sheets("Funds Table").Range("B4")
    .Range(Range("B1"), Range("B1").End(xlDown)).Copy Destination:=Sheets("Funds Table").Range("A4")
    .Range("DataTableX[#All]").RemoveDuplicates Columns:=4, Header:=xlYes
    Set LPID = .Cells.Range(Range("C1"), Range("C1").End(xlDown))
    Set InvestorName = .Cells.Range(Range("D1"), Range("D1").End(xlDown))
    End With

    LPID.Copy
    Sheets("Funds Table").Range("B2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    InvestorName.Copy
    Sheets("Funds Table").Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

    Sheets("Funds Table").Select
    Set Rng = Range(Range("B1:B3"), Range("B1:B3").End(xlToRight))
    Set rngB = Range(Range("B5"), Range("B5").End(xlDown))

    With Rng.Borders
        .LineStyle = xlContinuous
        .ThemeColor = 6
        .TintAndShade = 0
        .Weight = xlThin
    End With

    With rngB.Borders
        .LineStyle = xlContinuous
        .ThemeColor = 6
        .TintAndShade = 0
        .Weight = xlThin
    End With

    With Range("B3")
    .Font.Bold = "True"
    .Value = "Funds with IRR"
    .Interior.Pattern = xlSolid
    .Interior.ThemeColor = xlThemeColorAccent2
    End With

    Sheets("X").Delete

    With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    End With

ErrMsg:
MsgBox ("There are no funds that are within 3 Quarters from now"), , "Message Box:"

Call Six_Continue

End Sub

3 个答案:

答案 0 :(得分:1)

将代码格式化为:

Sub Five_Transpose()

...code...

On Error GoTo ErrMsg

...code...

ExitPoint:
   Call Six_Continue
   'run any cleanup, like turning _
   'screenupdating back on, etc.
Exit Sub

ErrMsg:
   MsgBox "There are no funds that " & _
       "are within 3 Quarters from now", _
       , "Message Box"
   Resume ExitPoint

End Sub

许多人认为使用出口点和错误处理程序的方法是最佳实践。虽然始终不适合,但很多时候都是如此。

通过这种方式设置程序,您仍然可以在退出时执行所有代码清理(关键,如果您正在关闭和打开开关,因为它确保将它们返回到所需的状态),你可以调用你的sub(只是确保它在这个程序出错并且依赖于此过程中的某些内容时不会出错),并且你可以在失败时向用户提供错误消息虽然仍然优雅地激发了潜艇。

它正常工作,因为如果代码成功,它只会继续向下通过ExitPoint行,然后退出。如果失败,它会立即跳转到错误处理程序,然后将其发送到ExitPoint

答案 1 :(得分:0)

  

防止错误处理代码在没有错误时运行   发生,放置一个Exit Sub,Exit Function或Exit Property语句   紧接错误处理例程之前,如下所示   片段:

Sub InitializeMatrix(Var1, Var2, Var3, Var4)
   On Error GoTo ErrorHandler
   . . .
   Exit Sub
ErrorHandler:
   . . .
   Resume Next
End Sub

来自帮助 https://msdn.microsoft.com/en-us/library/aa266173(v=vs.60).aspx

答案 2 :(得分:0)

这是一个如何使用错误处理的示例。我建议您在此处阅读有关错误处理的更多信息:(http://www.cpearson.com/excel/errorhandling.htm

sub test()

'define your variables

On Error GoTo errHandler:

'Some codes

errHandler:
 If Err.Number = -2147352567 Then
    MsgBox "Sorry, Something Went Wrong!"
    Exit Sub
 ElseIf Err.Number = 0 Then
    'no error no Action needed.
 Else
    MsgBox "An Error Occur!!" & vbCrLf & vbCrLf & _
    "Error Number: " & Err.Number & vbCrLf & _
    "Error Description: " & Err.Description
    Exit Sub
 End If

End Ub