Удаление строк с помощью For-L oop (в пределах диапазона нескольких областей)

Question

Обычно я удалял бы строки, используя For-L oop с номерами строк, работая в обратном направлении, что выглядело бы примерно так:

For rowIndex = 10 to 1 Step (-1)
    'delete Row with current row index
    next rowIndex

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

Dim someRange as Range
'Note: someRange might be a multi area range (multiple unadjoined cells) within one sheet
Dim singleCell as Range
For each singleCell In SomeRange.Cells
    'check for some condition e.g. based (but not limited to) the singleCell's value
    If condition = True then
        singleCell.EntireRow.Delete
        'Note: the deletion has to be done before the next loop-iteration starts
               'Unfortunately, this makes solutions like working with Union unfeasible
        End If
    Next singleCell

Кто-нибудь знает, как заставить работать второй блок кода без переключения на «Backward-Row-Number-L oop» (см. Первый блок кода)? Есть ли способ как-то "сбросить" указатель / счетчик singleCell на новое значение, чтобы l oop не пропускал следующую ячейку / строку? Или любой другой альтернативой (например, заставить Range-L oop работать в обратном направлении и т.д. c.)? Любая подсказка для решения будет принята с благодарностью, код также обрезан, но при необходимости я могу обойтись без.

Я должен избегать добавления нежелательной строки в массив (range et c.) И удаления весь массив после l oop сделано. К сожалению, как условие для реализации, строка должна быть удалена до того, как будет вычислена следующая ячейка.

По существу, может быть случай, когда две ячейки, строки которых должны быть удалены, будут находиться в одной строке. В этом случае вторая ячейка будет удалена еще до того, как она будет проверена, это желаемое поведение. Решение не должно, но должно быть расширяемым, чтобы включить этот случай.

РЕДАКТИРОВАТЬ: Другое решение, о котором я думаю, - это поменять диапазон перед выполнением For-L oop ( см. Здесь ), пока я еще не пробовал.

Answer 1

'Если вы удаляете строки вниз на основе критерия, номер строки следующей строки, подлежащей оценке, будет таким же, как текущий номер удаленной строки.

' Пожалуйста, попробуйте выполнить следующее.

Sub test()

Dim someRange As Range
'Note: someRange might be a multi area range (multiple unadjoined cells) 
within one sheet
Set someRange = Range("B1:B18")
J = someRange.Rows.Count
Dim i As Long
i = 1
Dim singleCell As Long
For singleCell = 1 To someRange.Rows.Count
'check for some condition
If someRange.Cells(singleCell, 1) = 0 Then
    someRange.Cells(singleCell, 1).EntireRow.Delete
    'now as the row is deleted you should reset the value of singleCell
    singleCell = singleCell - 1
    'Note: the deletion has to be done before the next loop-iteration starts
    End If


    i = i + 1
    If i = J Then Exit For
    'someRange.Rows.Count will be the max number of rows to be evaluated
    'otherwise there will be infinite loop and macro wont stop

Next


End Sub

Answer 2

Чтобы строго следовать вашему заявленному желанию сверху вниз удалить и учесть возможные множественные попадания в одну строку, а также разрешить несмежные диапазоны, я бы предложил , а не , используя для l oop, а точнее Do Loop над областями и строками в вашем someRange и For l oop над каждой строкой (завершайте For, когда вы получаете удар). Что-то вроде

Sub Demo()
    Dim rng As Range, cl As Range
    Dim someRange As Range
    Dim AreaRange As Range
    Dim DeletedRow As Boolean
    Dim areaNum As Long
    Dim i As Long

    ' Set your test range, eg
    Set someRange = [A1:F3,A8:F10,A16:F19]
    areaNum = 1
    ' Set first row to test
    Do
        ' Track discontiguous range areas
        Set AreaRange = someRange.Areas(areaNum)
        Set rng = someRange.Areas(areaNum).Rows(1)
        Do Until rng Is Nothing
            DeletedRow = False
            For Each cl In rng.Cells
                ' test condition, eg empty
                If IsEmpty(cl) Then
                    ' update rng to next row.  do this before the Delete
                    Set rng = Application.Intersect(someRange, rng.Offset(1, 0))
                    ' delete row
                    cl.EntireRow.Delete
                    DeletedRow = True
                    ' stop looping the row
                    Exit For
                End If
            Next
            ' if not already updated...
            If Not DeletedRow Then
                Set rng = Application.Intersect(someRange, rng.Offset(1, 0))
            End If
        Loop

        ' not all rows in area have been deleted, increment AreaNum
        ' AreaRange end up in a state where it's not Nothing, and isn't valid
        On Error Resume Next
            i = 0
            i = AreaRange.Count
        On Error GoTo 0
        If i > 0 Then
            areaNum = areaNum + 1
        End If
    Loop Until areaNum > someRange.Areas.Count
End Sub

Обратите внимание, что это будет довольно неэффективно, но соответствует вашим заявленным целям

Answer 3

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

Sub TestdeleteRows()
 Dim sh As Worksheet, someRange As Range, singleCell As Range, rngDel As Range
 Set sh = ActiveSheet ' use what sheet you need
 Set someRange = sh.Range("A2:A20")
 For Each singleCell In someRange.Cells
    If singleCell.Value = Empty Then
        If rngDel Is Nothing Then
            Set rngDel = singleCell
        Else
            Set rngDel = Union(rngDel, singleCell)
        End If
    End If
 Next
 rngDel.EntireRow.Delete xlUp
End Sub

Удаляет FullRow для пустых ячеек. Это может быть обусловлено всем необходимым.