Обратный L oop игнорирует некоторые ячейки

Question

Я написал небольшой код, который позволяет мне: в определенном диапазоне (xrng) в столбце F найти все ячейки, которые содержат определенный текст, и, найденный, выделить все ячейки в диапазоне A: G на том же грести и удалять их. У меня есть реверс l oop, который работает частично, так как игнорирует некоторые ячейки в диапазоне, в частности, 2-ю и 3-ю. Ниже и до и после пи c:

Вот мой код:

  Sub removeapp()

    Dim g As Long, xrng As Range, lastrow As Long, i As Long
    i = 4
    lastrow = Cells(Rows.Count, "F").End(xlUp).Row
    Set xrng = Range(Cells(lastrow, "F"), Cells(i, "F"))

        For g = xrng.Count To i Step -1

            If xrng.Cells(g).Value = "Adjustment" Or xrng.Cells(g).Value = "Approved" Then
            Range(Cells(xrng.Cells(g).Row(), "A"), Cells(xrng.Cells(g).Row(), "G")).Delete
            End If

        Next

    End Sub

Не могли бы вы помочь мне понять почему? Кроме того, код работает очень медленно ... если у вас есть подсказка, чтобы сделать его немного быстрее, было бы здорово!

Answer 1

Следующий код также достаточно быстрый, поскольку он выполняет итерацию между элементами массива (в памяти), не удаляет строку за строкой (создает объединение диапазонов) и удаляет все сразу:

Private Sub remoRangesAtOnce()
    Dim i As Long, lastRow As Long, sh As Worksheet
    Dim arrF As Variant, rng As Range, rngDel As Range

    Set sh = ActiveSheet 'please name it according to your sheet name
    lastRow = sh.Cells(sh.Rows.count, "F").End(xlUp).Row
    Set rng = sh.Range("F4:F" & lastRow)

    arrF = rng.Value
     For i = LBound(arrF) To UBound(arrF)
        If arrF(i, 1) = "Adjustment" Or arrF(i, 1) = "Approved" Then
            If rngDel Is Nothing Then
                Set rngDel = sh.Range(sh.Range("A" & i + 3), sh.Range("F" & i + 3))
            Else
                Set rngDel = Union(rngDel, sh.Range(sh.Range("A" & i + 3), sh.Range("F" & i + 3)))
            End If
        End If
     Next i
     If Not rngDel Is Nothing Then rngDel.Delete xlShiftUp
End Sub

Answer 2

Попробуйте, пожалуйста:

Sub removeappOrig()
    Dim xrng As Range, lastrow As Long, sh As Worksheet
    Set sh = ActiveSheet 'good to put here your real sheet
    lastrow = sh.Cells(sh.Rows.count, "F").End(xlUp).Row

    Set xrng = sh.Range("A4:F" & lastrow)
    xrng.AutoFilter field:=6, Criteria1:="=Adjustment", Operator:=xlOr, _ 
                            Criteria2:="=Approved", VisibleDropDown:=False

    Application.DisplayAlerts = False
        xrng.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True

    sh.AutoFilterMode = False
End Sub