尝试使用错误时转到与<label>错误清除

Question

我在多个excel实例上使用循环。我正在使用几个PC和实例来浏览我的数据，因此每个实例都将获取下一个可用的文件。如果多个实例打开相同的文件（CSV格式），VBA将会出现错误。我希望错误处理标签只需转到循环中的下一个文件即可。但是，我只能使此错误处理一次。周围第二次无法处理错误。如果代码的另一部分导致错误处理失败，我将整个代码保持完整。

Sub RunRoutine()

CloseOtherWorkbook
Application.StatusBar = False
manualcalc
Calculate
ListAllFile
Calculate
Sheets("RUN").Select
Set wBRun = ActiveWorkbook
Workbooks.Open Filename:=Range("FO_CalcName_Range").Value, ReadOnly:=True
Set wBCalc = ActiveWorkbook
wBRun.Activate
For Each C In ActiveSheet.Range("FILE_RANGE_RUN").Cells
    Err.Clear
    On Error GoTo Error_handler:
    wBRun.Activate
    Sheets("RUN").Select
    C.Select
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    If ActiveCell.Value = False Then
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Application.StatusBar = "Run Routine" & " - " & C
        Application.ScreenUpdating = False
        Range("Date_Range").Value = C
        ActiveSheet.Calculate
        FO_RawName = Range("FO_RawName_Range").Value
        Workbooks.Open FO_RawName, ReadOnly:=True 'this is where the code fails
        Set wBRaw = ActiveWorkbook
        wBRaw.Activate
        Columns("A:dn").Select
        Selection.Copy
        wBCalc.Activate
        Sheets("CALC").Select
        Columns("A:dn").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ResizeRows
        wBRaw.Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        wBRun.Activate
        RunallSheets
    Else
        'do nothing
    End If
Error_handler:
Next
Application.ScreenUpdating = True
wBCalc.Activate
ActiveWorkbook.Close False
Application.StatusBar = False
Application.ScreenUpdating = True
wBRun.Activate
manualcalc
ThisWorkbook.Save
Application.OnTime Now + TimeValue("00:10:00"), "RunRoutine"

结束sub

Answer 1

这不是在错误上使用的正确方法。

您必须这样使用：

Sub test()
 On Error GoTo Error_handler
'your code
NextItem:
Next
Application.ScreenUpdating = True
wBCalc.Activate
ActiveWorkbook.Close False
Application.StatusBar = False
Application.ScreenUpdating = True
wBRun.Activate
manualcalc
ThisWorkbook.Save
Application.OnTime Now + TimeValue("00:10:00"), "RunRoutine"
Exit Sub
Error_handler:
Resume NextItem
End Sub

Answer 2

gotos也可能避免，即使错误处理也是如此

最佳实践是处理错误有意识地，即当您期望它们并适当对待

时抓住它们

这意味着您必须在调试时将代码打开

例如，要捕获可能的工作簿开放例外，您可能需要：

• 具有打开工作簿并返回的特定功能：

  • True如果成功，以及打开的工作簿的对象引用

  • False如果不是

  喜欢，例如

  Function OpenWorkbook(wbName As String, wb As Workbook) As Boolean
      On Error Resume Next
      Set wb = Workbooks.Open(wbName, ReadOnly:=True)
      OpenWorkbook = Not wb Is Nothing
  End Function
  

• 使用它就像以下内容

      ... your code
      ActiveSheet.Calculate
      If OpenWorkbook(Range("FO_RawName_Range").Value, wBRaw) Then
          Columns("A:dn").Select '<--| this will select columns "A:DN" in wBRaw active sheet
          Selection.Copy
          wBCalc.Activate
          Sheets("CALC").Select
          Columns("A:dn").Select
          ActiveSheet.Paste
          Application.CutCopyMode = False
          ResizeRows
          wBRaw.Activate
          Application.CutCopyMode = False
          ActiveWorkbook.Close False
          wBRun.Activate
          RunallSheets
      End If
  

最后，您还可能要避免Activate/Active.../Select/Selection，并使用完全合格的范围参考来提高代码性能（在工作簿/工作表之间进行切换很及时），而不是放宽控制范围的控制

Answer 3

处理多个错误的最终代码：

Sub RunRoutine()

CloseOtherWorkbook
Application.StatusBar = False
manualcalc
Calculate
ListAllFile
Calculate
Sheets("RUN").Select
Set wBRun = ActiveWorkbook
Workbooks.Open Filename:=Range("FO_CalcName_Range").Value, ReadOnly:=True
Set wBCalc = ActiveWorkbook
wBRun.Activate
For Each C In ActiveSheet.Range("FILE_RANGE_RUN").Cells
    On Error GoTo Error_handler:
    wBRun.Activate
    Sheets("RUN").Select
    C.Select
    ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    If ActiveCell.Value = False Then
        Application.ScreenUpdating = True
        Application.StatusBar = False
        Application.StatusBar = "Run Routine" & " - " & C
        Application.ScreenUpdating = False
        Range("Date_Range").Value = C
        ActiveSheet.Calculate
        FO_RawName = Range("FO_RawName_Range").Value
        Workbooks.Open FO_RawName, ReadOnly:=True
        Set wBRaw = ActiveWorkbook
        wBRaw.Activate
        Columns("A:dn").Select
        Selection.Copy
        wBCalc.Activate
        Sheets("CALC").Select
        Columns("A:dn").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ResizeRows
        wBRaw.Activate
        Application.CutCopyMode = False
        ActiveWorkbook.Close False
        wBRun.Activate
        RunallSheets
    Else
        'do nothing
    End If
LabelA:
Next
Application.ScreenUpdating = True
wBCalc.Activate
ActiveWorkbook.Close False
Application.StatusBar = False
Application.ScreenUpdating = True
wBRun.Activate
manualcalc
ThisWorkbook.Save
Application.OnTime Now + TimeValue("00:10:00"), "RunRoutine"
Exit Sub
Error_handler:
Resume LabelA:
End Sub