Макрофильтрация ячеек VBA, как мне исправить ошибку «Ячейки не найдены»

Question

У меня есть код, который перемещает все непустые ячейки на листе в первую доступную пустую ячейку в их строке.

Вместо кода, работающего с полным листом, я бы хотел, чтобы он игнорировал столбцы A и B и строки 1, 2 и 3.

Для этого я изменяю .Range(.Cells(1, 1) на .Range(.Cells(4, 3), который отлично работает на свежих листах Excel с введенными тестовыми данными. Эти тестовые данные представляют собой просто случайно разбросанные данные, введенные в различные ячейки.

Когда я запускаю код на моем рабочем листе, Set delrng = .Rows(rw).Cells.SpecialCells(xlCellTypeBlanks) выдает ошибку Run-time error '1004': No cells were found. и ничего не выполняет.

Googling поднимает несколько тем по обработке ошибок No Cells were found, но я не думаю, что мне поможет просто удаление ошибки.

Спасибо.

Option Explicit

Sub Shift_Left()

Dim rw As Long, lr As Long, lc As Long, delrng As Range

With Worksheets("Application Maturity Tracker")
    lr = .Cells.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
            MatchCase:=False, SearchFormat:=False).Row
    lc = .Cells.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
            MatchCase:=False, SearchFormat:=False).Column

    With .Range(.Cells(1, 1), .Cells(lr, lc))
        For rw = 1 To .Rows.Count
            Set delrng = .Rows(rw).Cells.SpecialCells(xlCellTypeBlanks)
            If Not delrng Is Nothing Then
                delrng.Delete Shift:=xlToLeft
            End If
        Next rw

    End With

End With


End Sub

Answer 1

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

With .Range(.Cells(1, 1), .Cells(lr, lc))
    For rw = 1 To .Rows.Count
        On Error Resume Next
        Set delrng = .Rows(rw).SpecialCells(xlCellTypeBlanks).Cells
        On Error GoTo 0
        If Not delrng Is Nothing Then
            delrng.Delete Shift:=xlToLeft
        End If
    Next rw

End With