Обработка ошибок VBA GoTo Next Loop вместо возобновления

Этот код выдает ошибку, когда на вкладке импорта нет пути к файлу. Поэтому я включил 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

Вы предполагаете, что APC Refi Tracker.xlsb уже открыт. Ваш код находится в нем или в третьей книге? Вы используете F100. Есть ли данные ниже 100-й строки? Если этот Range("A1").CurrentRegion.Copy относится к ActiveSheet в только что открытой исходной книге, каково ее имя или индекс?

VBasic2008 25.12.2020 17:32

В VBA, если вы ищете структуру, которая позволяет вам «продолжать» со «следующего» оператора в цикле for, вы обычно смотрите на перемещение кода в отдельную функцию и используете защитные операторы в этой функции, которые меняют логику тестов, которые вынуждают продолжать попытки.

freeflow 25.12.2020 19:37

@VBasic2008 APC Refi Tracker.xlsb является хостом кода и открыт во время работы. Вкладка «Импорт» находится в Refi Tracker и содержит ссылки, однако часто возникает ситуация, когда у меня нет ссылки для этой конкретной сделки, и поэтому целью было бы пропустить это поле. Поскольку это приведет к ошибке в коде, я поэтому добавил в Error Resume Next, что, вероятно, не лучший способ обработки ошибок.

Juli44 25.12.2020 21:06

Это оставляет имя исходного рабочего листа или индекс (в моем решении, обозначаемом srcID) как единственную неуточненную «переменную». Это важно, потому что, если вы сохраните одну или несколько исходных книг с активным листом, отличным от ожидаемого, ваш код может (будет) давать сбой. Я имею в виду строку Range("A1").CurrentRegion.Copy, которая должна быть чем-то вроде SourceWb.Worksheets("Sheet1").Range("A1").CurrentRegion.Copy‌​.

VBasic2008 25.12.2020 21:21
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
3
4
721
4
Перейти к ответу Данный вопрос помечен как решенный

Ответы 4

Обновлено: исправлен код

Попробуйте этот код (кредит на редактирование super-symmetry , который также дал ссылку на этот пост):

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). В таком случае вам, вероятно, следует поставить строку On Error GoTo Leap перед открытием for; таким образом, он перейдет к следующей ячейке, если первая из списка пуста. Я также рекомендую ставить On Error GoTo -1 после закрытия for. Так:

    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

Ваш код будет работать для первой ошибки. Однако, если внутри цикла произойдет еще одна ошибка, ваш код завершится ошибкой, потому что вы не сообщили vba, что устранили первую ошибку. VBA нужен какой-то оператор Resume, чтобы убедиться, что ошибка устранена. Взгляните на этот пост.

Super Symmetry 25.12.2020 17:45

Ты прав. Спасибо. Я отредактирую ответ.

Evil Blue Monkey 25.12.2020 19:01

Я не думаю, что On Error Goto -1 жизнеспособно в VBA. Не могли бы вы поделиться ссылкой на документацию, если я ошибаюсь, или хотя бы поделиться тем, что она должна делать.

VBasic2008 25.12.2020 19:37

Я включил код выше в электронную таблицу. Однако он по-прежнему не пропускал операцию копирования и вставки после возникновения ошибки. Поэтому я сделал модификацию, чтобы переместить If Err <> 0 Then GoTo Error_Handler под Set SourceWb = Workbooks.Open(filePath). Он правильно перескакивает, когда есть пустая ссылка, однако, когда происходит переход с пустой ссылки на ссылку, которая открывается, он все равно выдает ошибку 1004 и не выполняет операцию копирования и вставки.

Juli44 26.12.2020 03:37

@VBasic2008: у меня есть это, и, похоже, оно работает на VBA. Я надеюсь, что это поможет ^^.

Evil Blue Monkey 26.12.2020 23:16

@ Juli44: спасибо за отзыв. Да, очевидно, я должен был поставить оператор if после этой строки. Явно глупая ошибка с моей стороны. Я посмотрю код глубже и посмотрю, смогу ли я найти, почему он не работает.

Evil Blue Monkey 26.12.2020 23:16

Хорошо, ошибка не была устранена, поэтому она продолжала пропускать процедуру копирования. Я сейчас отредактирую код. Не уверен, почему возникла эта ошибка 1004. Вы можете попробовать.

Evil Blue Monkey 26.12.2020 23:33

Подтверждение (доказательство) того, что On Error Goto -1 не используется с VBA . Это Visual Basic синтаксис. Посмотрите второй ответ на вопрос, который вы разместили в своем комментарии, и Обработку ошибок в VBA Чипа Пирсона.

VBasic2008 27.12.2020 07:23

Я бы сделал это по-другому. Я бы проверил путь, используя функцию 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

Имеет смысл. Но вы случайно не знаете, почему это было реализовано именно так?

Super Symmetry 25.12.2020 18:45

Я думаю, для сценариев, когда мы не знаем, что такое строка. Файл или каталог? Ex, когда мы получаем строку (скажем, из базы данных), и нам нужно проверить, действительна ли она?

Siddharth Rout 25.12.2020 19:06

Я не думаю, что вам следует избегать On Error например. что произойдет, если filePath будет видеофайлом? Конечно, вы можете создать массив разрешенных расширений для использования с Dir или некоторыми строковыми функциями, или использовать FileSystemObject или что-то еще, но это усложнит ситуацию. Комментарий freeflow может указывать на создание такой функции, как isExcelFile.

VBasic2008 25.12.2020 20:11

@ VBasic2008 О, определенно. Вы всегда должны делать правильную обработку, как я показал ЗДЕСЬ Так что да, я бы сделал правильную обработку, и я бы все равно сделал это так, как я показал выше :) Но тогда я уверен, что у каждого есть свои предпочтения.

Siddharth Rout 25.12.2020 20:36

Попробуй это:

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. Я протестировал вашу модификацию. Теперь код выдает ошибку 1004, которая возникает, когда Set SourceWb = Workbooks.Open(filePath) пусто. Я не уверен, почему это происходит, потому что в следующей строке написано On Error Resume Next, поэтому, на мой взгляд, это не должно останавливаться.

Juli44 26.12.2020 04:09

@Juli44 Juli44 эта ошибка 1004 произойдет, если указанный вами filePath на самом деле не существует. Если вы переместите On Error Resume Next непосредственно перед оператором set, он продолжится. Он прерывается с ошибкой 1004 прямо здесь, потому что позже мы снова включили проверку ошибок с помощью нашей команды On Error GoTo 0. Имеет ли это смысл?

SandPiper 26.12.2020 17:11
Ответ принят как подходящий

Импорт данных

Быстрое исправление

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

Спасибо, я проверил это, выдает ошибку нижнего индекса вне допустимого диапазона в этой строке Set rng = srcWB.Worksheets(srcID).Range(srcFirstCell).CurrentRegion. Знаете ли вы, как решить эту проблему @VBasic2008? Исходная рабочая книга будет меняться на протяжении всей операции, когда рабочие книги открываются и закрываются.

Juli44 26.12.2020 03:45

Вы изменили srcID на фактический name (или index) worksheet в Source Workbook? Вы читаете не из Source workbook, а из одного из его worksheets.

VBasic2008 26.12.2020 04:08

Спасибо, @ VBasic2008. После изменения фактического имени рабочего листа код теперь не выдает ошибку и выполняет операцию. Однако в моем случае для целей тестирования у меня есть ссылки в петле с 1 по 3, а затем у меня нет ссылок в петле с 4 по 6, а 7 - последняя ссылка. Единственная оставшаяся проблема заключается в том, что код теперь копирует информацию из «srcWB», открытого в цикле 7, в «dstWB», где необходимо сохранить данные цикла 4. Таким образом, в коде отсутствует счетчик ссылок, не открытых до цикла 7, чтобы скопировать его в нужное место назначения.

Juli44 26.12.2020 14:59

В коде найдите этот комментарий: Если рабочий лист не может быть открыт и вы хотите пропустить 149 строк, замените «k - 1» на «i - rFirstRow» в следующей строке. И не забудьте заменить Set dstWB = Workbooks("APC Refi Tracker.xlsb") на Set dstWB = ThisWorkbook по причинам, указанным в комментарии перед соответствующей строкой кода.

VBasic2008 26.12.2020 15:03

Другие вопросы по теме