Удаление столбца в диапазоне останавливает цикл

Question

Я пытаюсь удалить все столбцы на листе, которые содержат определенный текст в своих верхних строках.Тот же самый код с только окраской Cell.EntireColumn ячейки, которая соответствует тексту, работает отлично.

Делать это задом наперед не помогло.Установка нового диапазона, а затем удаление всего столбца работает, но мне приходится запускать код несколько раз, пока он не удалит все столбцы.

For Each Cell in newRange
    Cell.EntireColumn.Delete

В противном случае, когда я сделаю это с циклом выполнения, я получуошибка в конце.

Dim Cell As Range
Dim Source As Range
Set Source = Range(Cells(1, 1), Cells(1, Columns.Count))
Dim strWords As Variant
strWords = Array("Number", "First Name")

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
        Cell.EntireColumn.Delete
    Next i
Next

End Sub

В этой строке в самом первом цикле я получаю сообщение об ошибке: «Ошибка времени выполнения 424»: требуется объект »

If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then

Обновление: Добавление значений в диапазон работает отлично, и увеличение скорости заметно с большими файлами.Спасибо всем за участие!

Еще одна вещь, которую мне нужно сделать, была бы

If InStr(UCase(Cell), UCase(strWords(i))) 'is not in string Then
'Add to a union that will later be deleted

Я попробовал этот, но он удалил бы все столбцы вместо тех, которые не содержат один изструны.

If InStr(UCase(Cell), UCase(strWords(i))) = 0

Answer 1

Вы можете запустить более эффективный процесс, удалив все в конце. Попробуйте это ...

Dim Cell As Range
Dim Source As Range
Set Source = Range(Cells(1, 1), Cells(1, Columns.Count))
Dim strWords As Variant
strWords = Array("Number", "First Name")

Dim killRNG As Range
Set killRNG = Cells(1, Columns.Count).EntireColumn

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then
        Set killRNG = union(killRNG, Cell.EntireColumn)
        End If
    Next i
Next


killRNG.Delete (xlLeft)

Answer 2

Вам необходимо выйти из цикла For i после удаления Cell, в противном случае цикл i все еще пытается получить доступ к ячейке, которая была удалена.

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
            Cell.EntireColumn.Delete
            Exit For
        End If
    Next i
Next Cell

Или даже лучше собрать все ячейки (используя Union()) и удалить их в конце (намного быстрее)

Dim ColsToDelete As Range

For Each Cell In Source
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
            If ColsToDelete Is Nothing Then
                Set ColsToDelete = Cell.EntireColumn
            Else
                Set ColsToDelete = Union(ColsToDelete, Cell.EntireColumn)
            End If
            Exit For
        End If
    Next i
Next Cell

'delete all collected colmuns in the end at once
If Not ColsToDelete Is Nothing Then ColsToDelete.Delete

Обратите внимание, что когда вы используете union(), вам не нужно обязательно зацикливаться в обратном направлении Step -1 также будет работать прямой цикл, потому что вы удаляете все строки сразу в конце, а пока вы зацикливаете свои номера строк, этого не происходит измениться больше.

Чтобы также собрать столбцы, которые вы не удаляете (см. Комментарии ниже и отредактированный вопрос).

Dim ColsToDelete As Range
Dim ColsToKeep As Range, IsDeleted As Boolean

For Each Cell In Source
    IsDeleted = False 'initialize
    For i = UBound(strWords) To LBound(strWords) Step -1
        If InStr(UCase(Cell), UCase(strWords(i))) > 0 Then 
            IsDeleted = True
            If ColsToDelete Is Nothing Then
                Set ColsToDelete = Cell.EntireColumn
            Else
                Set ColsToDelete = Union(ColsToDelete, Cell.EntireColumn)
            End If
            Exit For
        End If
    Next i
    If Not IsDeleted Then
        If ColsToKeep Is Nothing Then
            Set ColsToKeep = Cell.EntireColumn
        Else
            Set ColsToKeep = Union(ColsToKeep, Cell.EntireColumn)
        End If   
    End If 
Next Cell

'delete all collected rows in the end at once
If Not ColsToDelete Is Nothing Then ColsToDelete.Delete

Обратите внимание, что я изменил имя переменной RowsToDelete на ColsToDelete, потому что она была названа неправильно.