VBA错误处理使用GoTo下一个循环而非继续。

Question

当导入标签中没有文件路径时，此代码会产生错误。因此，我包含了 On Error Resume Next ，以便运行下一个循环。但是，在 On Error Resume Next 之后，该代码继续通过复制操作进行运行，从而破坏了我要复制到的标签。

我发现解决方法是在出现错误时将代码输入下一个循环，而不是继续操作。有人对如何更改错误处理方式有任何意见吗？

Sub ImportBS()

Dim filePath As String
Dim SourceWb As Workbook
Dim TargetWb As Workbook
Dim Cell As Range
Dim i As Integer
Dim k As Integer
Dim Lastrow As Long


'SourceWb - Workbook were data is copied from
'TargetWb - Workbook were data is copied to and links are stored

Application.ScreenUpdating = False

Set TargetWb = Application.Workbooks("APC Refi Tracker.xlsb")
Lastrow = TargetWb.Sheets("Import").Range("F100").End(xlUp).Row - 6


    For k = 1 To Lastrow
    

        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        Set SourceWb = Workbooks.Open(filePath)
    
    On Error Resume Next
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close

    Next

Application.ScreenUpdating = True

Worksheets("Import").Activate

    MsgBox "All done!"

End Sub

- Juli44

---

你假设 APC Refi Tracker.xlsb 已经打开。你的代码是在其中还是在第三个工作簿中？你正在使用 F100。在第100行以下是否有任何数据？如果 Range("A1").CurrentRegion.Copy 是指刚打开的源工作簿中的 ActiveSheet，那么它的名称或索引是什么？ - VBasic2008

在VBA中，如果你正在寻找一种结构，允许你从for循环中的“下一个”语句中“继续”，通常你需要将代码移动到一个单独的函数中，并在该函数中使用守卫语句来反转强制继续尝试的测试逻辑。 - freeflow

@VBasic2008 APC Refi Tracker.xlsb是代码的主机，并在操作时处于打开状态。导入选项卡位于Refi Tracker中，并承载链接，然而经常会出现这样的情况，即我没有这个特定交易的链接，因此目的是跳过该字段。由于这会在代码中产生错误，因此我添加了"On Error Resume Next"，这可能不是一个很好的错误处理方式。 - Juli44

这留下了源工作表名称或索引（在我的解决方案中称为“srcID”）作为唯一未明确的“变量”。 这很重要，因为如果您将一个或多个源工作簿保存为活动工作表不是预期工作表之一，您的代码可能会（将）失败。 我正在参考行Range("A1").CurrentRegion.Copy，它应该类似于SourceWb.Worksheets("Sheet1").Range("A1").CurrentRegion.Copy。 - VBasic2008

Answer 1

我会有不同的做法。我会使用Dir函数来检查路径，然后再决定该做什么。以下是一个示例：

For k = 1 To Lastrow
    filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
    
    '~~> Check if the path is valid
    If Not Dir(filePath, vbNormal) = vbNullString Then
        Set SourceWb = Workbooks.Open(filePath)
        
        '
        '~~> Rest of your code
        '
    End If
Next

- Siddharth Rout

---

有道理。但是你是否知道为什么要以这种方式实现它？ - Super Symmetry

我猜这种情况是我们不知道字符串是什么。文件还是目录？例如，当我们从数据库获取一个字符串并需要检查它是否有效时。 - Siddharth Rout

我认为你不应该避免使用 On Error，例如如果 filePath 是一个视频文件会发生什么？当然，你可以创建一个允许扩展名的数组来与 Dir 或一些字符串函数一起使用，或者使用 FileSystemObject 等等，但这会使事情变得复杂。freeflow 的评论可能表明要创建一个类似于 isExcelFile 的函数。 - VBasic2008

@VBasic2008 当然。你应该像我在这里所展示的那样，始终进行适当的处理。所以是的，我会进行适当的处理，并且仍然会按照我上面展示的方式进行处理 :) 但我相信每个人都有自己的偏好。 - Siddharth Rout

Answer 2

编辑：修正代码

尝试使用以下代码（感谢super-symmetry的编辑，该编辑还链接到了this post）：

Sub ImportBS()
    
    Dim filePath As String
    Dim SourceWb As Workbook
    Dim TargetWb As Workbook
    Dim Cell As Range
    Dim i As Integer
    Dim k As Integer
    Dim Lastrow As Long
    
    
    'SourceWb - Workbook were data is copied from
    'TargetWb - Workbook were data is copied to and links are stored
    
    Application.ScreenUpdating = False
    
    Set TargetWb = Application.Workbooks("APC Refi Tracker.xlsb")
    Lastrow = TargetWb.Sheets("Import").Range("F100").End(xlUp).Row - 6
    
    On Error Resume Next
    
    For k = 1 To Lastrow
        
        
        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        
        Set SourceWb = Workbooks.Open(filePath)
        
        If Err <> 0 Then GoTo Error_Handler
        
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
Leap:
    Next
    
    On Error GoTo -1
    
    Exit Sub
    
    Error_Handler:
    Err.Clear
    GoTo Leap
    
End Sub    

---

首先（错误的）答案:

如果你想在出现错误的情况下跳过代码的一部分，你可以使用类似这样的方法:

    For k = 1 To Lastrow
    

        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        Set SourceWb = Workbooks.Open(filePath)
    
    On Error GoTo Leap
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
Leap:
    Next

我认为错误应该发生在Set SourceWb = Workbooks.Open(filePath)这一行。在这种情况下，您可能需要在for循环的开头放置On Error GoTo Leap这一行; 这样，如果列表中的第一个单元格为空，它将跳转到下一个单元格。我还建议在for循环结束后放置On Error GoTo -1。像这样：

    On Error GoTo Leap
    
    For k = 1 To Lastrow
    

        filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
        Set SourceWb = Workbooks.Open(filePath)
        
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
Leap:
    Next
    
    On Error GoTo -1

- Evil Blue Monkey

---

你的代码可以处理第一个错误。但是，如果循环内发生另一个错误，你的代码将失败，因为你没有告诉VBA你已经处理了第一个错误。VBA需要某种“恢复”语句来确认错误已经被处理。请参考这篇文章。 - Super Symmetry

你说得对。谢谢。我会编辑答案的。 - Evil Blue Monkey

我认为在VBA中On Error Goto -1不可行。如果我错了，你能否分享文档链接或者至少告诉我它应该做什么？ - VBasic2008

我在电子表格中包含了上面的代码。然而，一旦出现错误，它仍然没有跳过复制和粘贴操作。因此，我进行了修改，将 If Err <> 0 Then GoTo Error_Handler 移动到 Set SourceWb = Workbooks.Open(filePath) 下面。它可以正确地跳过空链接，但是一旦从空链接更改为打开链接，它仍然会产生1004错误，并且不执行复制粘贴操作。 - Juli44

@VBasic2008：我有这个，它似乎在VBA上可以工作。希望它能帮到你^^。 - Evil Blue Monkey

Answer 3

导入数据

快速修复

For k = 1 To Lastrow
    filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
    Set SourceWb = Nothing
    On Error Resume Next
    Set SourceWb = Workbooks.Open(filePath)
    On Error GoTo 0
    If Not SourceWb Is Nothing Then
        Range("A1").CurrentRegion.Copy
        TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial Paste:=xlPasteValues
        Range("A1").Copy
        Application.CutCopyMode = False
        SourceWb.Close
    'Else ' File not found.
    End If
Next

一项改进

• 未经测试。
• 在使用代码之前，请调整（检查）常量部分中的值。

---

Option Explicit

Sub ImportBS()

    ' Destination Read
    Const rName As String = "Import" ' where file paths are stored.
    Const rFirstRow As Long = 7
    Const rCol As Variant = "F" ' or 6
    ' Destination Write
    Const wName As String = "Balance Sheet Drop" ' where data is copied to.
    Const wFirstCell As String = "D2"
    Const wRowOffset As Long = 149
    ' Source
    Const srcID As Variant = "Sheet1" ' or e.g. 1 ' where data is copied from.
    Const srcFirstCell As String = "A1"
    
    ' Define Destination Worksheets.
    ' Note that if the workbook "APC Refi Tracker.xlsb" contains this
    ' code, you should use 'Set dstWB = ThisWorkbook' instead which would
    ' make the code more readable, but would also allow you to change
    ' the workbook's name and the code would still work.
    Dim dstWB As Workbook: Set dstWB = Workbooks("APC Refi Tracker.xlsb")
    Dim wsR As Worksheet: Set wsR = dstWB.Worksheets(rName)
    Dim wsW As Worksheet: Set wsW = dstWB.Worksheets(wName)
    
    ' Define Last Row in Destination Read Worksheet.
    Dim rLastRow As Long
    With dstWB.Worksheets(rName)
        rLastRow = .Cells(.Rows.Count, rCol).End(xlUp).Row
    End With
    
    ' Declare additional variables to use in the upcoming loop.
    Dim srcFilePath As String  ' Source File Path
    Dim srcWB As Workbook      ' Source Workbook
    Dim rng As Range           ' Source Range
    Dim i As Long              ' Destination Read Worksheet Rows Counter
    Dim k As Long              ' Destination Write Worksheet Write Counter
    
    Application.ScreenUpdating = False
    
    ' Loop through rows of Destination Read Worksheet
    ' (or loop through Source Workbooks).
    For i = rFirstRow To rLastRow
        ' Read Current Source File Path from Destination Read Worksheet.
        srcFilePath = wsR.Cells(i, rCol).Value
        ' Attempt to open Current Source Workbook.
        Set srcWB = Nothing
        On Error Resume Next
        Set srcWB = Workbooks.Open(srcFilePath)
        On Error GoTo 0
        ' If Current Source Workbook was opened...
        If Not srcWB Is Nothing Then
            ' Define Source Range.
            Set rng = srcWB.Worksheets(srcID).Range(srcFirstCell).CurrentRegion
            ' Define Destination First Cell Range.
            k = k + 1
            ' If a worksheet could not be opened and you want to skip
            ' the 149 lines then replace 'k - 1' with 'i - rFirstRow'
            ' in the following line.
            With wsW.Range(wFirstCell).Offset((k - 1) * wRowOffset)
                ' Write values from Source Range to Destination Range.
                .Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
            End With
            ' Close Source Workbook.
            srcWB.Close SaveChanges:=False
        'Else ' Current Source Workbook was not found.
        End If
    Next
    ' Note that there has been no change of the 'Selection' in any
    ' of the worksheets i.e. what was active at the beginning is still active.
       
    ' Save Destination Workbook.
    'dstWB.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Data sets copied    : " & k & vbLf _
        & "Data sets not copied: " & i - rFirstRow - k, vbInformation, "Success"

End Sub

- VBasic2008

---

谢谢，我测试了一下，发现在这行代码 Set rng = srcWB.Worksheets(srcID).Range(srcFirstCell).CurrentRegion 中出现了下标超出范围的错误。你知道如何解决吗，@VBasic2008？源工作簿将在操作过程中不断变化，因为工作簿会被打开和关闭。 - Juli44

你是否将srcID更改为Source Workbook中实际的worksheet名称（或索引）？你并没有从Source Workbook中读取，而是从其中一个worksheet中读取。 - VBasic2008

谢谢你，@VBasic2008。在更改为实际工作表名称后，代码现在不会产生错误并且可以运行操作。然而，在我的测试中，我在循环1到3中有链接，然后在循环4到6中没有链接，7是最后一个链接。唯一剩下的问题是，代码现在正在将从循环7打开的'srcWB'中的信息复制到'dstWB'中，其中需要保存循环4的数据。因此，代码缺少未打开的链接计数器，直到循环7才将其复制到正确的目标位置。 - Juli44

在代码中查找此注释：如果无法打开工作表并且您想跳过149行，则请将以下行中的'k-1'替换为'i-rFirstRow'。不要忘记根据相关代码行前的注释将Set dstWB = Workbooks("APC Refi Tracker.xlsb")替换为Set dstWB = ThisWorkbook。 - VBasic2008

Answer 4

试试这个：

For k = 1 To Lastrow
    filePath = TargetWb.Sheets("Import").Range("F" & 6 + k).Value
    Set SourceWb = Workbooks.Open(filePath)

    On Error Resume Next
    Range("A1").CurrentRegion.Copy
    If Err <> 0 Then GoTo ContinuationPoint
    On Error GoTo 0
    TargetWb.Sheets("Balance Sheet Drop").Range("D" & 2 + (k - 1) * 149).PasteSpecial 
    Paste:=xlPasteValues
    Range("A1").Copy
    Application.CutCopyMode = False
    SourceWb.Close

ContinuationPoint:
    On Error GoTo 0
Next

注意两件事情。我在那里加了两次 On Error GoTo 0。当您使用 On Error Resume Next 时，您基本上关闭了错误处理。现在我们把它重新打开。如果在尝试复制时出现错误，则会跳转到 ContinuationPoint（您可以将其重命名为任何想要的名称）。无论如何，我们都重新开启错误处理。

- SandPiper

---

感谢@SandPiper，我测试了您的修改 - 现在代码会产生一个1004错误，这是由于Set SourceWb = Workbooks.Open(filePath)为空引起的。我不确定为什么会发生这种情况，因为下一行说“On Error Resume Next”，所以在我看来它不应该停止。 - Juli44

@Juli44，如果您指定的filePath实际上不存在，那么就会出现1004错误。如果将On Error Resume Next移动到设置语句之前，它将继续执行。因为我们稍后使用On Error GoTo 0命令重新打开了错误检查，所以它在那里中断并显示1004错误。这有意义吗？ - SandPiper