Как остановить ошибку VBA, когда нет данных для копирования - PullRequest
0 голосов
/ 06 августа 2020

У меня есть макрос VBA, который фильтрует данные и копирует результаты на другой лист. Все было хорошо, когда футбольные сезоны по всему миру были в самом разгаре, но теперь, когда многие завершили свои прерванные сезоны, данных стало меньше. Что происходит, когда нет данных для передачи, я получаю сообщение об ошибке выполнения 1004: «Ячейки не найдены». Некоторые из этих макросов вызываются по порядку, поэтому, когда он останавливается, другие не продолжают работу.

Вот код

   Dim arr, ws As Worksheet, lc As Long, lr As Long

    arr = Array("S.EPL-DE-AUT-Home-Win", "S.Gre_HomeWin", "S.Ger_EPL_NL_Pol_SPL_HomeWin", _
                "S.DE_EPL_LALiga_Big_Odds_Jolly")

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    With ws.Range("A1", ws.Cells(lr, lc))
        .HorizontalAlignment = xlCenter
        .AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues
        .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    End With
      
    Workbooks("Predictology-Reports.xlsx").Sheets("Football Profits") _
          .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
End Sub

Есть ли способ не игнорировать ли ячейки для копирования? Затем я могу внести ту же поправку во все остальные.

заранее приветствую

Просто для обновления, код был изменен, чтобы добавить IF для выхода из подпрограммы, если нет данных. Вот исправленный код:

Sub FALAYS()
   Dim arr, ws As Worksheet, lc As Long, lr As Long

    arr = Array("L.FAL_19_New_Summer2", "L.FA_FAL_3", "L.FAL_19_New_Summer")

    Set ws = ActiveSheet
    'range from A1 to last column header and last row
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lr = ws.Cells.Find("*", after:=ws.Range("A1"), LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    With ws.Range("A1", ws.Cells(lr, lc))
        .HorizontalAlignment = xlCenter
        .AutoFilter Field:=1, Criteria1:=arr, Operator:=xlFilterValues
        If .Rows.Count - 1 > 0 Then
            .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    Else
            Exit Sub
        End If
    End With
      
    Workbooks("Predictology-Reports.xlsx").Sheets("FAL") _
          .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
End Sub

К сожалению, если данных нет, по-прежнему отображается ошибка времени выполнения 1004. В строке .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy ячеек не найдено. Есть мысли о том, что не так?

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...