Этот код выдает ошибку, когда на вкладке импорта нет пути к файлу. Поэтому я включил 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
В VBA, если вы ищете структуру, которая позволяет вам «продолжать» со «следующего» оператора в цикле for, вы обычно смотрите на перемещение кода в отдельную функцию и используете защитные операторы в этой функции, которые меняют логику тестов, которые вынуждают продолжать попытки.
@VBasic2008 APC Refi Tracker.xlsb является хостом кода и открыт во время работы. Вкладка «Импорт» находится в Refi Tracker и содержит ссылки, однако часто возникает ситуация, когда у меня нет ссылки для этой конкретной сделки, и поэтому целью было бы пропустить это поле. Поскольку это приведет к ошибке в коде, я поэтому добавил в Error Resume Next, что, вероятно, не лучший способ обработки ошибок.
Это оставляет имя исходного рабочего листа или индекс (в моем решении, обозначаемом srcID
) как единственную неуточненную «переменную». Это важно, потому что, если вы сохраните одну или несколько исходных книг с активным листом, отличным от ожидаемого, ваш код может (будет) давать сбой. Я имею в виду строку Range("A1").CurrentRegion.Copy
, которая должна быть чем-то вроде SourceWb.Worksheets("Sheet1").Range("A1").CurrentRegion.Copy
.
Обновлено: исправлен код
Попробуйте этот код (кредит на редактирование 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
, чтобы убедиться, что ошибка устранена. Взгляните на этот пост.
Ты прав. Спасибо. Я отредактирую ответ.
Я не думаю, что On Error Goto -1
жизнеспособно в VBA. Не могли бы вы поделиться ссылкой на документацию, если я ошибаюсь, или хотя бы поделиться тем, что она должна делать.
Я включил код выше в электронную таблицу. Однако он по-прежнему не пропускал операцию копирования и вставки после возникновения ошибки. Поэтому я сделал модификацию, чтобы переместить If Err <> 0 Then GoTo Error_Handler
под Set SourceWb = Workbooks.Open(filePath)
. Он правильно перескакивает, когда есть пустая ссылка, однако, когда происходит переход с пустой ссылки на ссылку, которая открывается, он все равно выдает ошибку 1004 и не выполняет операцию копирования и вставки.
@VBasic2008: у меня есть это, и, похоже, оно работает на VBA. Я надеюсь, что это поможет ^^.
@ Juli44: спасибо за отзыв. Да, очевидно, я должен был поставить оператор if после этой строки. Явно глупая ошибка с моей стороны. Я посмотрю код глубже и посмотрю, смогу ли я найти, почему он не работает.
Хорошо, ошибка не была устранена, поэтому она продолжала пропускать процедуру копирования. Я сейчас отредактирую код. Не уверен, почему возникла эта ошибка 1004. Вы можете попробовать.
Подтверждение (доказательство) того, что On Error Goto -1
не используется с VBA . Это Visual Basic синтаксис. Посмотрите второй ответ на вопрос, который вы разместили в своем комментарии, и Обработку ошибок в VBA Чипа Пирсона.
Я бы сделал это по-другому. Я бы проверил путь, используя функцию 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
Имеет смысл. Но вы случайно не знаете, почему это было реализовано именно так?
Я думаю, для сценариев, когда мы не знаем, что такое строка. Файл или каталог? Ex, когда мы получаем строку (скажем, из базы данных), и нам нужно проверить, действительна ли она?
Я не думаю, что вам следует избегать On Error
например. что произойдет, если filePath
будет видеофайлом? Конечно, вы можете создать массив разрешенных расширений для использования с Dir
или некоторыми строковыми функциями, или использовать FileSystemObject
или что-то еще, но это усложнит ситуацию. Комментарий freeflow может указывать на создание такой функции, как isExcelFile
.
@ VBasic2008 О, определенно. Вы всегда должны делать правильную обработку, как я показал ЗДЕСЬ Так что да, я бы сделал правильную обработку, и я бы все равно сделал это так, как я показал выше :) Но тогда я уверен, что у каждого есть свои предпочтения.
Попробуй это:
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 Juli44 эта ошибка 1004 произойдет, если указанный вами filePath
на самом деле не существует. Если вы переместите On Error Resume Next
непосредственно перед оператором set, он продолжится. Он прерывается с ошибкой 1004 прямо здесь, потому что позже мы снова включили проверку ошибок с помощью нашей команды On Error GoTo 0
. Имеет ли это смысл?
Быстрое исправление
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? Исходная рабочая книга будет меняться на протяжении всей операции, когда рабочие книги открываются и закрываются.
Вы изменили srcID
на фактический name
(или index
) worksheet
в Source Workbook
? Вы читаете не из Source workbook
, а из одного из его worksheets
.
Спасибо, @ VBasic2008. После изменения фактического имени рабочего листа код теперь не выдает ошибку и выполняет операцию. Однако в моем случае для целей тестирования у меня есть ссылки в петле с 1 по 3, а затем у меня нет ссылок в петле с 4 по 6, а 7 - последняя ссылка. Единственная оставшаяся проблема заключается в том, что код теперь копирует информацию из «srcWB», открытого в цикле 7, в «dstWB», где необходимо сохранить данные цикла 4. Таким образом, в коде отсутствует счетчик ссылок, не открытых до цикла 7, чтобы скопировать его в нужное место назначения.
В коде найдите этот комментарий: Если рабочий лист не может быть открыт и вы хотите пропустить 149 строк, замените «k - 1» на «i - rFirstRow» в следующей строке. И не забудьте заменить Set dstWB = Workbooks("APC Refi Tracker.xlsb")
на Set dstWB = ThisWorkbook
по причинам, указанным в комментарии перед соответствующей строкой кода.
Вы предполагаете, что
APC Refi Tracker.xlsb
уже открыт. Ваш код находится в нем или в третьей книге? Вы используетеF100
. Есть ли данные ниже 100-й строки? Если этотRange("A1").CurrentRegion.Copy
относится кActiveSheet
в только что открытой исходной книге, каково ее имя или индекс?